When I run a VBScript that calls a function, is it possible to somehow get information about which .dll library the WScript engine used to implement the function?
I haven't tried anything yet due to I don't know where to start.
EDIT:
Here's more detail on what I'm trying to do:
Option VBASupport 1
Option Compatible
REM This works like a charm:
Sub CreateAndRunVBScript
Dim dbPath$
dbPath = Environ("userprofile") & "\Desktop\MyAccesDb.accdb"
Dim rtfPath$
rtfPath = Environ("userprofile") & "\Desktop\help1.rtf"
Dim VbsPath$
VbsPath = Environ("userprofile") & "\Desktop\My2Script.vbs"
Dim strScript As String
strScript= "Const adTypeBinary = 1" & chr(13) & chr(10) & _
"Const adInteger = 3" & chr(13) & chr(10) & _
"Const adParamInput = 1"& chr(13) & chr(10) & _
"Const OleObject = 205"& chr(13) & chr(10) & _
"Dim cat" & chr(13) & chr(10) & _
"Dim connstr" & chr(13) & chr(10) & _
"Dim dbPath" & chr(13) & chr(10) & _
"Dim rtfPath"& chr(13) & chr(10) & _
"Dim fso" & chr(13) & chr(10) & _
"Dim sql" & chr(13) & chr(10) & _
"dbPath = " & chr(34) & dbPath & chr(34) & chr(13) & chr(10) & _
"rtfPath = " & chr(34) & rtfPath & chr(34) & chr(13) & chr(10) & _
"Set fso = CreateObject(" & chr(34) & "Scripting.Filesystemobject" & chr(34) & ")" & chr(13) & chr(10) & _
"If fso.FileExists(" & chr(34) & dbPath & chr(34) & ") Then" & chr(13) & chr(10) & _
"fso.DeleteFile " & chr(34) & dbPath & chr(34) & chr(13) & chr(10) & _
"End If" & chr(13) & chr(10) & _
"Set fso = Nothing" & chr(13) & chr(10) & _
"Set cat = CreateObject(" & chr(34) & "ADOX.Catalog" & chr(34) & ")" & chr(13) & chr(10) & _
"connstr = " & chr(34) & "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=" & dbPath & ";" & chr(34) & chr(13) & chr(10) & _
"cat.Create connstr" & chr(13) & chr(10) & _
"Set cat = Nothing" & chr(13) & chr(10) & _
"Dim conn" & chr(13) & chr(10) & _
"Set conn = CreateObject(" & chr(34) & "ADODB.Connection" & chr(34) & ")" & chr(13) & chr(10) & _
"conn.Open connstr" & chr(13) & chr(10) & _
"sql = " & chr(34) & "CREATE TABLE [RTFTABLE] ([ID] int IDENTITY(1,1) PRIMARY KEY, [RTFDATA] OleObject);" & chr(34) & chr(13) & chr(10) & _
"conn.Execute sql" & chr(13) & chr(10) & _
"sql = " & chr(34) & "SELECT ID, RTFDATA FROM RTFTABLE" & chr(34) & chr(13) & chr(10) & _
"conn.Execute sql" & chr(13) & chr(10) & _
"Dim strm" & chr(13) & chr(10) & _
"Dim bytes" & chr(13) & chr(10) & _
"Dim bsize" & chr(13) & chr(10) & _
"Set strm = CreateObject(" & chr(34) & "ADODB.Stream" & chr(34) & ")" & chr(13) & chr(10) & _
"strm.Type = adTypeBinary" & chr(13) & chr(10) & _
"strm.Open" & chr(13) & chr(10) & _
"strm.LoadFromFile " & chr(34) & rtfPath & chr(34) & chr(13) & chr(10) & _
"strm.Position = 0" & chr(13) & chr(10) & _
"bytes = strm.Read()" & chr(13) & chr(10) & _
"bsize = LenB(bytes)" & chr(13) & chr(10) & _
"strm.Close()" & chr(13) & chr(10) & _
"Set strm = Nothing" & chr(13) & chr(10) & _
"Dim cmd" & chr(13) & chr(10) & _
"Set cmd = CreateObject(" & chr(34) & "ADODB.Command" & chr(34) & ")" & chr(13) & chr(10) & _
"cmd.ActiveConnection = conn" & chr(13) & chr(10) & _
"cmd.CommandText = " & chr(34) & "INSERT INTO RTFTABLE (ID, RTFDATA) VALUES (?,?)" & chr(34) & chr(13) & chr(10) & _
"cmd.Parameters.Append cmd.CreateParameter(" &chr(34) & "ID" & chr(34) & ", adInteger, adParamInput, , 1)" & chr(13) & chr(10) & _
"cmd.Parameters.Append cmd.CreateParameter(" & chr(34) & "RTFDATA" & chr(34) & ", OleObject, adParamInput, bsize, bytes)" & chr(13) & chr(10) & _
"cmd.Execute" & chr(13) & chr(10) & _
"Set cmd = Nothing" & chr(13) & chr(10) & _
"conn.Close" & chr(13) & chr(10) & _
"Set conn = Nothing"
Open VbsPath For Output As #1
Print #1, strScript: Close #1
Dim sCommand$
sCommand ="WScript " & VbsPath
Shell sCommand, 2, , True
Kill VbsPath
End Sub
Another tuning which does not work as expected:
Option VBASupport 1
Option Explicit
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Sub StartToWork
Dim basePath$, rtfPath$, dbPath$
basePath = Environ("userprofile") & "\Desktop"
rtfPath = basePath & "\" & "help1.rtf"
dbPath = basePath & "\" &"MyAccesDb.accdb"
CreateDatabase dbPath
InsertRTFData dbPath, rtfPath
'ReadFromDb dbPath, rtfPath
End Sub
Sub CreateDatabase(dbPath As String)
Dim cat As Object
Dim connstr As String
If Dir(dbPath) <> "" Then Kill dbPath
Set cat = CreateObject("ADOX.Catalog")
connstr = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=" & dbPath & ";"
cat.Create connstr
Set cat = Nothing
Dim conn As Object
Set conn = CreateObject("ADODB.Connection")
conn.Open connstr
Dim sql As String
sql = "CREATE TABLE [RTFTABLE] ([ID] int IDENTITY(1,1) PRIMARY KEY, [RTFDATA] OleObject);"
conn.Execute sql
conn.Close
Set conn = Nothing
End Sub
Sub InsertRTFData(dbPath As String, rtfPath As String)
Const adTypeBinary = 1
Const adTypeText = 2
Const adModeReadWrite = 3
Const adInteger = 3
Const adParamInput = 1
Const OleObject= 205
Dim conn As Object, connstr As String, sql As String
Set conn = CreateObject("ADODB.Connection")
connstr = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=" & dbPath & ";"
conn.Open connstr
sql = "SELECT ID, RTFDATA FROM RTFTABLE"
conn.Execute sql
Dim bytes () As Byte, bsize As Long, mHwnd As Long
bytes = FileToBlob(rtfPath)
Dim lb As Long, pa As Long
lb = LoadLibrary("C:\Program Files\Common Files\microsoft shared\OFFICE16\ACEDAO.DLL")
'MsgBox lb
pa = GetProcAddress(lb, "__VarLenB")
bsize = pa(bytes) ' this is crap
FreeLibrary lb
Dim cmd As Object
Set cmd = CreateObject("ADODB.Command")
cmd.ActiveConnection = conn
cmd.CommandText = "INSERT INTO RTFTABLE (ID, RTFDATA) VALUES (?,?)"
cmd.Parameters.Append cmd.CreateParameter("ID", adInteger, adParamInput, , 1)
cmd.Parameters.Append cmd.CreateParameter("RTFDATA", OleObject, adParamInput, bsize, bytes) 'excecution fails here!
'I haven't found a way to get bsize which should be LenB(bytes).
'LibreOffice Basic (sbasic) LENB function is in this case completely useless.
cmd.Execute
Set cmd = Nothing
conn.Close
Set conn = Nothing
End Sub
Function FileToBlob(FilePath As String) As Variant
Dim bytesRead() As Byte
Open FilePath For Binary As #1
ReDim bytesRead(LOF(1) - 1)
Get #1, , bytesRead : Close #1
FileToBlob = bytesRead
Erase bytesRead
End Function
Sub ReadFromDb(dbPath As String, rtfPath As String)
Const adTypeBinary = 1
Dim conn As Object, connstr As String, sql As String
Set conn = CreateObject("ADODB.Connection")
connstr = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=" & dbPath & ";"
conn.Open connstr
Dim rs As Object
Set rs = CreateObject("ADODB.Recordset")
sql = "SELECT RTFDATA FROM RTFTABLE;"
rs.Open sql, conn, 3, 3, 1
If Not rs.EOF Then rs.MoveLast
Dim bytes() As Byte
bytes = rs.Fields.Item("RTFDATA").Value
rs.Close
Set rs = nothing
conn.Close
Set conn = Nothing
End Sub
I'd like to avoid using of external macros.
EDIT: Additional information.
It might be better to clarify. I'm working with LibreOffice Basic macros (VBA-Support on) on Windows 11. I have no other installations related to Ms Office/VBA than AccesDataBaseEngine 2016 (x64) on my system. I've tried to figure out what dll offers the LenB function. After further investigation I'm pretty sure that it's C:\Program Files\Common Files\microsoft shared\OFFICE16\EXPSRV.DLL which will be installed with the AccessDataBaseEngine installation. When I made a deeper dive into this, I realized that the problem can't be solved by declaring and calling the function in my LibreOffice Basic macro due to LibreOffice Basic does not have the variable LongPtr. This results in you not being able to pass the correct type of arguments to function calls. I also tried to install 32-bit version of AccessDatabaseEngine, but the problem worsened. LibreOffice then claims that e.g ADOX is missing or not registered when I'm trying to create object: Set cat = CreateObject("ADOX.Catalog")
When I run a VBScript that calls a function, is it possible to somehow get information about which .dll library the WScript engine used to implement the function?
I haven't tried anything yet due to I don't know where to start.
EDIT:
Here's more detail on what I'm trying to do:
Option VBASupport 1
Option Compatible
REM This works like a charm:
Sub CreateAndRunVBScript
Dim dbPath$
dbPath = Environ("userprofile") & "\Desktop\MyAccesDb.accdb"
Dim rtfPath$
rtfPath = Environ("userprofile") & "\Desktop\help1.rtf"
Dim VbsPath$
VbsPath = Environ("userprofile") & "\Desktop\My2Script.vbs"
Dim strScript As String
strScript= "Const adTypeBinary = 1" & chr(13) & chr(10) & _
"Const adInteger = 3" & chr(13) & chr(10) & _
"Const adParamInput = 1"& chr(13) & chr(10) & _
"Const OleObject = 205"& chr(13) & chr(10) & _
"Dim cat" & chr(13) & chr(10) & _
"Dim connstr" & chr(13) & chr(10) & _
"Dim dbPath" & chr(13) & chr(10) & _
"Dim rtfPath"& chr(13) & chr(10) & _
"Dim fso" & chr(13) & chr(10) & _
"Dim sql" & chr(13) & chr(10) & _
"dbPath = " & chr(34) & dbPath & chr(34) & chr(13) & chr(10) & _
"rtfPath = " & chr(34) & rtfPath & chr(34) & chr(13) & chr(10) & _
"Set fso = CreateObject(" & chr(34) & "Scripting.Filesystemobject" & chr(34) & ")" & chr(13) & chr(10) & _
"If fso.FileExists(" & chr(34) & dbPath & chr(34) & ") Then" & chr(13) & chr(10) & _
"fso.DeleteFile " & chr(34) & dbPath & chr(34) & chr(13) & chr(10) & _
"End If" & chr(13) & chr(10) & _
"Set fso = Nothing" & chr(13) & chr(10) & _
"Set cat = CreateObject(" & chr(34) & "ADOX.Catalog" & chr(34) & ")" & chr(13) & chr(10) & _
"connstr = " & chr(34) & "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=" & dbPath & ";" & chr(34) & chr(13) & chr(10) & _
"cat.Create connstr" & chr(13) & chr(10) & _
"Set cat = Nothing" & chr(13) & chr(10) & _
"Dim conn" & chr(13) & chr(10) & _
"Set conn = CreateObject(" & chr(34) & "ADODB.Connection" & chr(34) & ")" & chr(13) & chr(10) & _
"conn.Open connstr" & chr(13) & chr(10) & _
"sql = " & chr(34) & "CREATE TABLE [RTFTABLE] ([ID] int IDENTITY(1,1) PRIMARY KEY, [RTFDATA] OleObject);" & chr(34) & chr(13) & chr(10) & _
"conn.Execute sql" & chr(13) & chr(10) & _
"sql = " & chr(34) & "SELECT ID, RTFDATA FROM RTFTABLE" & chr(34) & chr(13) & chr(10) & _
"conn.Execute sql" & chr(13) & chr(10) & _
"Dim strm" & chr(13) & chr(10) & _
"Dim bytes" & chr(13) & chr(10) & _
"Dim bsize" & chr(13) & chr(10) & _
"Set strm = CreateObject(" & chr(34) & "ADODB.Stream" & chr(34) & ")" & chr(13) & chr(10) & _
"strm.Type = adTypeBinary" & chr(13) & chr(10) & _
"strm.Open" & chr(13) & chr(10) & _
"strm.LoadFromFile " & chr(34) & rtfPath & chr(34) & chr(13) & chr(10) & _
"strm.Position = 0" & chr(13) & chr(10) & _
"bytes = strm.Read()" & chr(13) & chr(10) & _
"bsize = LenB(bytes)" & chr(13) & chr(10) & _
"strm.Close()" & chr(13) & chr(10) & _
"Set strm = Nothing" & chr(13) & chr(10) & _
"Dim cmd" & chr(13) & chr(10) & _
"Set cmd = CreateObject(" & chr(34) & "ADODB.Command" & chr(34) & ")" & chr(13) & chr(10) & _
"cmd.ActiveConnection = conn" & chr(13) & chr(10) & _
"cmd.CommandText = " & chr(34) & "INSERT INTO RTFTABLE (ID, RTFDATA) VALUES (?,?)" & chr(34) & chr(13) & chr(10) & _
"cmd.Parameters.Append cmd.CreateParameter(" &chr(34) & "ID" & chr(34) & ", adInteger, adParamInput, , 1)" & chr(13) & chr(10) & _
"cmd.Parameters.Append cmd.CreateParameter(" & chr(34) & "RTFDATA" & chr(34) & ", OleObject, adParamInput, bsize, bytes)" & chr(13) & chr(10) & _
"cmd.Execute" & chr(13) & chr(10) & _
"Set cmd = Nothing" & chr(13) & chr(10) & _
"conn.Close" & chr(13) & chr(10) & _
"Set conn = Nothing"
Open VbsPath For Output As #1
Print #1, strScript: Close #1
Dim sCommand$
sCommand ="WScript " & VbsPath
Shell sCommand, 2, , True
Kill VbsPath
End Sub
Another tuning which does not work as expected:
Option VBASupport 1
Option Explicit
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Sub StartToWork
Dim basePath$, rtfPath$, dbPath$
basePath = Environ("userprofile") & "\Desktop"
rtfPath = basePath & "\" & "help1.rtf"
dbPath = basePath & "\" &"MyAccesDb.accdb"
CreateDatabase dbPath
InsertRTFData dbPath, rtfPath
'ReadFromDb dbPath, rtfPath
End Sub
Sub CreateDatabase(dbPath As String)
Dim cat As Object
Dim connstr As String
If Dir(dbPath) <> "" Then Kill dbPath
Set cat = CreateObject("ADOX.Catalog")
connstr = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=" & dbPath & ";"
cat.Create connstr
Set cat = Nothing
Dim conn As Object
Set conn = CreateObject("ADODB.Connection")
conn.Open connstr
Dim sql As String
sql = "CREATE TABLE [RTFTABLE] ([ID] int IDENTITY(1,1) PRIMARY KEY, [RTFDATA] OleObject);"
conn.Execute sql
conn.Close
Set conn = Nothing
End Sub
Sub InsertRTFData(dbPath As String, rtfPath As String)
Const adTypeBinary = 1
Const adTypeText = 2
Const adModeReadWrite = 3
Const adInteger = 3
Const adParamInput = 1
Const OleObject= 205
Dim conn As Object, connstr As String, sql As String
Set conn = CreateObject("ADODB.Connection")
connstr = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=" & dbPath & ";"
conn.Open connstr
sql = "SELECT ID, RTFDATA FROM RTFTABLE"
conn.Execute sql
Dim bytes () As Byte, bsize As Long, mHwnd As Long
bytes = FileToBlob(rtfPath)
Dim lb As Long, pa As Long
lb = LoadLibrary("C:\Program Files\Common Files\microsoft shared\OFFICE16\ACEDAO.DLL")
'MsgBox lb
pa = GetProcAddress(lb, "__VarLenB")
bsize = pa(bytes) ' this is crap
FreeLibrary lb
Dim cmd As Object
Set cmd = CreateObject("ADODB.Command")
cmd.ActiveConnection = conn
cmd.CommandText = "INSERT INTO RTFTABLE (ID, RTFDATA) VALUES (?,?)"
cmd.Parameters.Append cmd.CreateParameter("ID", adInteger, adParamInput, , 1)
cmd.Parameters.Append cmd.CreateParameter("RTFDATA", OleObject, adParamInput, bsize, bytes) 'excecution fails here!
'I haven't found a way to get bsize which should be LenB(bytes).
'LibreOffice Basic (sbasic) LENB function is in this case completely useless.
cmd.Execute
Set cmd = Nothing
conn.Close
Set conn = Nothing
End Sub
Function FileToBlob(FilePath As String) As Variant
Dim bytesRead() As Byte
Open FilePath For Binary As #1
ReDim bytesRead(LOF(1) - 1)
Get #1, , bytesRead : Close #1
FileToBlob = bytesRead
Erase bytesRead
End Function
Sub ReadFromDb(dbPath As String, rtfPath As String)
Const adTypeBinary = 1
Dim conn As Object, connstr As String, sql As String
Set conn = CreateObject("ADODB.Connection")
connstr = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=" & dbPath & ";"
conn.Open connstr
Dim rs As Object
Set rs = CreateObject("ADODB.Recordset")
sql = "SELECT RTFDATA FROM RTFTABLE;"
rs.Open sql, conn, 3, 3, 1
If Not rs.EOF Then rs.MoveLast
Dim bytes() As Byte
bytes = rs.Fields.Item("RTFDATA").Value
rs.Close
Set rs = nothing
conn.Close
Set conn = Nothing
End Sub
I'd like to avoid using of external macros.
EDIT: Additional information.
It might be better to clarify. I'm working with LibreOffice Basic macros (VBA-Support on) on Windows 11. I have no other installations related to Ms Office/VBA than AccesDataBaseEngine 2016 (x64) on my system. I've tried to figure out what dll offers the LenB function. After further investigation I'm pretty sure that it's C:\Program Files\Common Files\microsoft shared\OFFICE16\EXPSRV.DLL which will be installed with the AccessDataBaseEngine installation. When I made a deeper dive into this, I realized that the problem can't be solved by declaring and calling the function in my LibreOffice Basic macro due to LibreOffice Basic does not have the variable LongPtr. This results in you not being able to pass the correct type of arguments to function calls. I also tried to install 32-bit version of AccessDatabaseEngine, but the problem worsened. LibreOffice then claims that e.g ADOX is missing or not registered when I'm trying to create object: Set cat = CreateObject("ADOX.Catalog")
Share Improve this question asked Mar 11 at 13:01 PertsaPertsa 13 bronze badges 9 | Show 4 more comments1 Answer
Reset to default 0I managed to get this to work a little differently, still using the Access DB Engine and some NETFX tools.
Instructions, a test file (a simple .rtf with one text line and an image) used in my tuning and my LibreOffice Basic project file
LenBis not an API. It's a function internal to Visual Basic. – Raymond Chen Commented Mar 11 at 14:33