I have a problem referencing a windows object in VBA. it throws the following error: "Error 5 (Invalid procedure call or argument). I cannot find the cause, because I see no programming error.
Public Sub TestWindowhandle()
Dim lResult As Long
Dim objShell, wins, winn
Dim IE_Count As Long, i As Long, This_PID As Long
On Error GoTo TestWindowhandle_Error
Set objShell = CreateObject("Shell.Application")
Set wins = objShell.Windows
IE_Count = wins.Count
For i = 0 To (IE_Count - 1)
Set winn = wins.Item(i)
Next i
On Error GoTo 0
Exit Sub
TestWindowhandle_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in line " & Erl & " in procedure TestWindowhandle of Module Module1"
Stop
End Sub
Something odd with that interface, it seems to only work with a copy of the control variable so:
Set winn = wins.Item(i + 0)
or
Set winn = wins.Item((i))
I believe here is what is happening.
The Item method accepts a Variant parameter.
When calling an external method that accepts a Variant parameter, VB likes to create and pass Variants that provide the value by reference - that is, with the VT_BYREF flag set.
However VB does not set this flag when sending out intermediate results (temporaries, not stored in a variable), which makes sense because even if the called method updates the value, no one will be able to see it.
So when you call .Item(i), VB sends out a Variant of type VT_I4 | VT_BYREF, and when you call .Item(i + 0), a Variant of type VT_I4 is dispatched, without the VT_BYREF.
In most situations the difference is not significant because VARIANT-aware methods should be able to cope with either. However this particular method does different things depending on exactly which VT_ it receives, and because of this it is explicitly willing to reject any VT_s other than the three accepted ones. So in order to call it you need to trick VB into removing the byref flag.
Interestingly, when you declare the variable as Variant, VB still dispatches a VT_VARIANT | VT_BYREF, but the method seems to support this situation and correctly resolves to the pointed-to inner Variant that has the non-reference type of VT_I4.
Note this has nothing to do with VB's ByVal/ByRef - this is about the internal structure of the VARIANT data type.
Related
I have a problem as below.
A program is written using early binding in VBA and it only works with all the references connected.
but there are some systems where the references are not connected and when the program is ran on those systems there is a compile error.
so I thought maybe I can use late binding to connect the references but it still shows compile error.
condition is that I cant convert the variables in code to late binding.
Public oPart As Part
Sub CATMain()
Dim refname()
Dim reffullPath()
Dim refGUID()
ReDim refname(5)
refname() = Array("INFITF,MECMOD", "ProductStructureTypeLib")
ReDim reffullPath(5)
reffullPath() = Array("D:\opt\ds\catia\B28_VWGROUP\win_b64\code\bin\MecModTypeLib.tlb", "D:\opt\ds\catia\B28_VWGROUP\win_b64\code\bin\PSTypeLib.tlb")
ReDim refGUID(5)
refGUID() = Array("{0D90A5C9-3B08-11D1-A26C-0000F87546FD}", "{5065F8B6-61BB-11D1-9D85-0000F8759F82}")
CheckAndAddReference refname(), reffullPath(), refGUID()
End Sub
Sub CheckAndAddReference(refname() As Variant, refLocation() As Variant, refGUID() As Variant)
Set VBAEditorx = CreateObject("MSAPC.Apc").VBE 'Application.VBE
Set vbProj = VBAEditorx.ActiveVBProject 'ActiveWorkbook.VBProject
For j = 0 To UBound(refname)
For i = 1 To vbProj.References.Count
RefCon = False
If vbProj.References.Item(i).Name = refname(j) Then
RefCon = True
Exit For
End If
Next
If RefCon = False Then
vbProj.References.AddFromFile refLocation(j)
End If
Next
End Sub
the first line "Public oPart As Part" , I cant make it as Object because there are many of these in original program.
the above line requires a reference called "INFITF,MECMOD" which is not connected in some systems.
when I try to late bind it, it is showing the error as
Compile error:
user type not defined
so I wanted to ask weather i can late bind the reference while the line "Public oPart As Part" remains same in the code without showing an error.
or I need to make all the early bound objects into "As Object".
Why does a string variable need to be enclosed in a cStr() conversion to be used as a key string for the CreateObject("WScript.Shell").SpecialFolders collection?
Demonstration of this absurdity(?):
Sub sdfgdfsg()
Const strCon_SpecialFolderName As String = "MyDocuments"
Dim strVar_SpecialFolderName As String
strVar_SpecialFolderName = "MyDocuments"
Debug.Print CreateObject("WScript.Shell").SpecialFolders(strCon_SpecialFolderName) ' CORRECT
Debug.Print CreateObject("WScript.Shell").SpecialFolders(strVar_SpecialFolderName) ' WRONG! (it returns the Desktop path instead)
Debug.Print CreateObject("WScript.Shell").SpecialFolders(CStr(strVar_SpecialFolderName)) ' CORRECT
Debug.Print CreateObject("WScript.Shell").SpecialFolders("MyDocuments") ' CORRECT
End Sub
I read the documentation about the index argument for a collection without finding an answer.
The WScript library was designed to be used from scripting languages such as VBScript which use Variants. The SpecialFolders.Item that you are calling expects a Variant containing a string, too.
The result you are seeing appears to come from the fact that the library is not able to read the Variant-wrapped string value VB passes, and does something wrong instead. You can achieve the same result with
Dim strVar_SpecialFolderName As String
strVar_SpecialFolderName = vbNullString
'Returns C:\Users\Public\Desktop
Debug.Print CreateObject("WScript.Shell").SpecialFolders(strVar_SpecialFolderName)
For reasons I don't fully understand, there sometimes is a problem with passing Variant-wrapped data from VBA to an external object. I speculate that it may have something to do with the presence or absence of the VT_BYREF flag in the Variant that VB(A) produces, and it produces it differently for constants, local variables and temporaries.
I believe this to be a problem on the receiving side, not in VBA.
Workarounds include:
Declaring the variable as Variant to begin with:
Dim strVar_SpecialFolderName As Variant
strVar_SpecialFolderName = "MyDocuments"
Debug.Print CreateObject("WScript.Shell").SpecialFolders(strVar_SpecialFolderName)
Forcing an evaluation which turns the local variable into a temporary (that is what your CStr does, too) which apparently changes how VB packs it into a Variant:
Dim strVar_SpecialFolderName As String
strVar_SpecialFolderName = "MyDocuments"
Debug.Print CreateObject("WScript.Shell").SpecialFolders((strVar_SpecialFolderName))
Hey maybe I'm not seeing something obvious here but how can you use the Find VBA function with a predefined variable. I'm using a concatenation of a string assigned from a user form and just "total " in front of it, yet I can't return the row.
Below is my code
Dim HBWS As Worksheet
Dim TickerString As String
TickerString = "Total " & TTB
Set HBWS = Sheets("Hoenheimm Worksheet")
BorrowColumn = HBWS.Cells.Find(What:="Borrow").Column 'Works just fine
TickerRow = HBWS.Cells.Find(What:=TickerString).Row 'Throws an error
Note that TTB is set to a ticker ex. AAPL, and I can check in my local windows that Tickerstring is in fact = to "Total AAPL"
I would expect the .Row column to give me the row on my worksheet as to where this string is located.
EDIT: the error being thrown is as follows...
"Run-Time error '91':
Object Variable or With block variable not set"
Any throughts,
Thanks
You're invoking Range.Find. That method returns a Range object reference - and when it does not find what it's told to look for, it returns Nothing, i.e. a null reference.
TickerRow = HBWS.Cells.Find(What:=TickerString).Row 'Throws an error
What this code is doing (and the working instruction just above it), is assuming that Find returns a valid object reference.
Apparently HBWS.Cells does not contain "Total " & TTB (whatever TTB is), so your code is effectively trying to invoke Range.Row against a Range reference that's Nothing... which is illegal, and raises run-time error 91 as you're experiencing.
You shouldn't assume that Find will return a valid reference, ever. Split it up, and validate the returned object reference with an If ... Is Nothing check:
Set tickerResult = HBWS.Cells.Find(What:=TickerString)
If Not tickerResult Is Nothing Then
tickerRow = tickerResult.Row
Else
'tickerString was not found.
'watch for leading/trailing/extra spaces if the string does *look* legit.
End If
When calling Range.Find, you should always provide a value for the optional parameters, because its implementation "remembers" values from previous invocations, and this is easily bug-prone.
I think I've stumbled upon a bug in Excel - I'd really like to verify it with someone else though.
The bug occurs when reading the Workbook.VBProject.HelpFile property when the workbook has been opened with the opening application's .AutomationSecurity property set to ForceDisable. In that case this string property returns a (probably) malformed Unicode string, which VBA in turn displays with question marks. Running StrConv(..., vbUnicode) on it makes it readable again, but it sometimes looses the last character this way; this might indicate that the unicode string is indeed malformed or such, and that VBA therefore tries to convert it first and fails.
Steps to reproduce this behaviour:
Create a new Excel workbook
Go to it's VBA project (Alt-F11)
Add a new code module and add some code to it (like e.g. Dim a As Long)
Enter the project's properties (menu Tools... properties)
Enter "description" as Project description and "abc.hlp" as Help file name
Save the workbook as a .xlsb or .xlsm
Close the workbook
Create a new Excel workbook
Go to it's VBA project (Alt-F11)
Add a fresh new code module
Paste the code below in it
Adjust the path on the 1st line so it points to the file you created above
Run the Test routine
The code to use:
Const csFilePath As String = "<path to your test workbook>"
Sub TestSecurity(testType As String, secondExcel As Application, security As MsoAutomationSecurity)
Dim theWorkbook As Workbook
secondExcel.AutomationSecurity = security
Set theWorkbook = secondExcel.Workbooks.Open(csFilePath)
Call MsgBox(testType & " - helpfile: " & theWorkbook.VBProject.HelpFile)
Call MsgBox(testType & " - helpfile converted: " & StrConv(theWorkbook.VBProject.HelpFile, vbUnicode))
Call MsgBox(testType & " - description: " & theWorkbook.VBProject.Description)
Call theWorkbook.Close(False)
End Sub
Sub Test()
Dim secondExcel As Excel.Application
Set secondExcel = New Excel.Application
Dim oldSecurity As MsoAutomationSecurity
oldSecurity = secondExcel.AutomationSecurity
Call TestSecurity("enabled macros", secondExcel, msoAutomationSecurityLow)
Call TestSecurity("disabled macros", secondExcel, msoAutomationSecurityForceDisable)
secondExcel.AutomationSecurity = oldSecurity
Call secondExcel.Quit
Set secondExcel = Nothing
End Sub
Conclusion when working from Excel 2010:
.Description is always readable, no matter what (so it's not like all string properties behave this way)
xlsb and xlsm files result in an unreadable .HelpFile only when macros are disabled
xls files result in an unreadable .HelpFile in all cases (!)
It might be even weirder than that, since I swear I once even saw the questionmarks-version pop up in the VBE GUI when looking at such a project's properties, though I'm unable to reproduce that now.
I realize this is an edge case if ever there was one (except for the .xls treatment though), so it might just have been overlooked by Microsoft's QA department, but for my current project I have to get this working properly and consistently across Excel versions and workbook formats...
Could anyone else test this as well to verify my Excel installation isn't hosed? Preferably also with another Excel version, to see if that makes a difference?
Hopefully this won't get to be a tumbleweed like some of my other posts here :) Maybe "Tumbleweed generator" might be a nice badge to add...
UPDATE
I've expanded the list of properties to test just to see what else I could find, and of all the VBProject's properties (BuildFileName, Description, Filename, HelpContextID, HelpFile, Mode, Name, Protection and Type) only .HelpFile has this problem of being mangled when macros are off.
UPDATE 2
Porting the sample code to Word 2010 and running that exhibits exactly the same behaviour - the .HelpFile property is malformed when macros are disabled. Seems like the code responsible for this is Office-wide, probably in a shared VBA library module (as was to be expected TBH).
UPDATE 3
Just tested it on Excel 2007 and 2003, and both contain this bug as well. I haven't got an Excel XP installation to test it out on, but I can safely say that this issue already has a long history :)
I've messed with the underlying binary representation of the strings in question, and found out that the .HelpFile string property indeed returns a malformed string.
The BSTR representation (underwater binary representation for VB(A) strings) returned by the .HelpFile property lists the string size in the 4 bytes in front of the string, but the following content is filled with the ASCII representation and not the Unicode (UTF16) representation as VBA expects.
Parsing the content of the BSTR returned and deciding for ourselves which format is most likely used fixes this issue in some circumstances. Another issue is unfortunately at play here as well: it only works for even-length strings... Odd-length strings get their last character chopped off, their BSTR size is reported one short, and the ASCII representation just doesn't include the last character either... In that case, the string cannot be recovered fully.
The following code is the example code in the question augmented with this fix. The same usage instructions apply to it as for the original sample code. The RecoverString function performs the needed magic to, well, recover the string ;) DumpMem returns a 50-byte memory dump of the string you pass to it; use this one to see how the memory is layed out exactly for the passed-in string.
Const csFilePath As String = "<path to your test workbook>"
Private Declare Sub CopyMemoryByte Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Byte, ByVal Source As Long, ByVal Length As Integer)
Private Declare Sub CopyMemoryWord Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Integer, ByVal Source As Long, ByVal Length As Integer)
Private Declare Sub CopyMemoryDWord Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Long, ByVal Source As Long, ByVal Length As Integer)
Function DumpMem(text As String) As String
Dim textAddress As LongPtr
textAddress = StrPtr(text)
Dim dump As String
Dim offset As Long
For offset = -4 To 50
Dim nextByte As Byte
Call CopyMemoryByte(nextByte, textAddress + offset, 1)
dump = dump & Right("00" & Hex(nextByte), 2) & " "
Next
DumpMem = dump
End Function
Function RecoverString(text As String) As String
Dim textAddress As LongPtr
textAddress = StrPtr(text)
If textAddress <> 0 Then
Dim textSize As Long
Call CopyMemoryDWord(textSize, textAddress - 4, 4)
Dim recovered As String
Dim foundNulls As Boolean
foundNulls = False
Dim offset As Long
For offset = 0 To textSize - 1
Dim nextByte As Byte
Call CopyMemoryByte(nextByte, textAddress + offset, 1)
recovered = recovered & Chr(CLng(nextByte) + IIf(nextByte < 0, &H80, 0))
If nextByte = 0 Then
foundNulls = True
End If
Next
Dim isNotUnicode As Boolean
isNotUnicode = isNotUnicode Mod 2 = 1
If foundNulls And Not isNotUnicode Then
recovered = ""
For offset = 0 To textSize - 1 Step 2
Dim nextWord As Integer
Call CopyMemoryWord(nextWord, textAddress + offset, 2)
recovered = recovered & ChrW(CLng(nextWord) + IIf(nextWord < 0, &H8000, 0))
Next
End If
End If
RecoverString = recovered
End Function
Sub TestSecurity(testType As String, secondExcel As Application, security As MsoAutomationSecurity)
Dim theWorkbook As Workbook
secondExcel.AutomationSecurity = security
Set theWorkbook = secondExcel.Workbooks.Open(csFilePath)
Call MsgBox(testType & " - helpfile: " & theWorkbook.VBProject.HelpFile & " - " & RecoverString(theWorkbook.VBProject.HelpFile))
Call MsgBox(testType & " - description: " & theWorkbook.VBProject.Description & " - " & RecoverString(theWorkbook.VBProject.Description))
Call theWorkbook.Close(False)
End Sub
Sub Test()
Dim secondExcel As Excel.Application
Set secondExcel = New Excel.Application
Dim oldSecurity As MsoAutomationSecurity
oldSecurity = secondExcel.AutomationSecurity
Call TestSecurity("disabled macros", secondExcel, msoAutomationSecurityForceDisable)
Call TestSecurity("enabled macros", secondExcel, msoAutomationSecurityLow)
secondExcel.AutomationSecurity = oldSecurity
Call secondExcel.Quit
Set secondExcel = Nothing
End Sub
I have a VBA function that initializes a lotus notes session, creates a document and mails it. It also accepts as an optional parameter a NotesRichTextItem which I append to the body of the email.
However, I am getting the error message "All objects must be from the same session". How do I 'import' this NotesRichTextItem into my session?
Edit-Code added
Sub SendLotusMail(SubjTxt As String, _
BodyTxt As String, _
EmailTo As String, _
EmailCC As String, _
AutoSend As Boolean, _
Attach As String, _
ReportTitle As String, _
Optional AppendToBody As NotesRichTextItem = Null)
On Error GoTo EH
NtSession.Initialize
OpenMailDb ReportTitle
Set NtDoc = Ntdb.CreateDocument
NtDoc.AppendItemValue "Form", "Memo"
NtDoc.AppendItemValue "SendTo", EmailTo
NtDoc.AppendItemValue "CopyTo", EmailCC
NtDoc.AppendItemValue "Subject", SubjTxt
Set NtBodyRT = NtDoc.CreateRichTextItem("Body")
NtDoc.AppendItemValue "Body", NtBodyRT
If Attach <> "" Then NtBodyRT.EmbedObject EMBED_ATTACHMENT, "", Attach, "Attachment"
NtBodyRT.AppendText BodyTxt
'This next line throws the error "All objects must be from the same session"
NtBodyRT.AppendRTItem AppendToBody
Edit-Solution found
I don't like it very much, but I got around all these issues by passing the RichTextItem object, it's parent NotesDocument, and it's parent's parent NotesSession to this function. So, now I'm calling this procedure with 3 optional objects instead of 1. Hooray.
Edit-New Solution found
Well, the previous solution was causing me problems, so until I find (or someone suggests) a workaround, I'll just use some custom email procedures for the reports that require it. It does duplicate some code, but not significantly.
The issue may be the fact that the NtSession object is being re-initialized in your sub. If the calling routine sends in a rich text item, I am assuming it must have created and initialized a NotesSession as well. If that's the case, you would want your code to re-use that same session. It looks like NtSession is a global - if that's the case, you could:
Enforce that the calling routing always have initialized that global session;
Optionally pass in a NtSession object as an argument (and your code can check if that object is null before creating and initializing its own session); or
Before calling Initialize, check if NtSession already is initialized - to do that, you may be able to check an attribute and see if the object throws on error (non-tested code):
function isNotesSessionInitialized (ns)
on error goto err
dim sUser
sUser = ""
sUser = ns.commonUserName
err:
if (sUser = "") then
return false
else
return true
end if
end function
It would help to see some code here. I'll make a guess at what is happening, though.
In your VBA function, you'll need to create a new NotesRichTextItem object within your email. For instance:
Dim docMail as New NotesDocument(db)
Dim rtBody as New NotesRichTextItem(docMail, "Body")
Call rtBody.AppendRTItem(myRTparameter)
I imagine that should work without an error.
(I'm writing this to close out my question)
I've gotten around this issue by just having separate email procs for the reports that require custom setups. Yes, there is some duplication of code, but it's far better than the behemoth I was about to make.