Ok, so I have these functions I'm tring to use via my vba code.
It's probably the as it would have been with vbs as well.
Here's the function(s)
'declarations for working with Ini files
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias _
"GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, _
ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias _
"GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, _
ByVal lpFileName As String) As Long
'// INI CONTROLLING PROCEDURES
'reads an Ini string
Public Function ReadIni(Filename As String, Section As String, Key As String) As String
Dim RetVal As String * 255, v As Long
v = GetPrivateProfileString(Section, Key, "", RetVal, 255, Filename)
ReadIni = Left(RetVal, v + 0)
End Function
'reads an Ini section
Public Function ReadIniSection(Filename As String, Section As String) As String
Dim RetVal As String * 255, v As Long
v = GetPrivateProfileSection(Section, RetVal, 255, Filename)
ReadIniSection = Left(RetVal, v + 0)
End Function
How can I use this to create a function that basically allows me to specify only the section I want to look in, and then find each ini string within that section and put it into an array and return that Array so I can do a loop with it?
Edit: I see that ReadIniSection returns all of the keys in a huge string.
Meaning, I need to split it up.
ReadIniSection returns something that looks like this:
"Fornavn=FORNAVN[]Etternavn=ETTERNAVN" etc etc. The[] in the middle there isn't brackets, it's a square. Probably some character it doesn't recognize. So I guess I should run it through a split command that takes the value between a = and the square.
See if this helps - splitting on nullchar \0:
Private Sub ListIniSectionLines()
Dim S As String: S = ReadIniSection("c:\windows\win.ini", "MAIL")
Dim vLines As Variant: vLines = Split(S, Chr$(0))
Dim vLine As Variant
For Each vLine In vLines
Debug.Print vLine
Next vLine
End Sub
Related
Is it really not possible to declare a 0-length array in VBA? If I try this:
Dim lStringArr(-1) As String
I get a compile error saying range has no values. If I try to trick the compiler and redim at runtime like this:
ReDim lStringArr(-1)
I get a subscript out of range error.
I've varied the above around a bit but with no luck e.g.
Dim lStringArr(0 To -1) As String
Use Case
I want to convert a variant array to a string array. The variant array may be empty as it comes from the Keys property of a dictionary. The keys property gives back an array of variants. I want an array of strings to use in my code, as I have some functions for processing string arrays I'd like to use. Here's the conversion function I'm using. This throws a subscript out of range error due to lMaxIndex being = -1:
Public Function mVariantArrayToStringArray(pVariants() As Variant) As String()
Dim lStringArr() As String
Dim lMaxIndex As Long, lMinIndex As Long
lMaxIndex = UBound(pVariants)
lMinIndex = LBound(pVariants)
ReDim lStringArr(lMaxIndex)
Dim lVal As Variant
Dim lIndex As Long
For lIndex = lMinIndex To lMaxIndex
lStringArr(lIndex) = pVariants(lIndex)
Next
mVariantArrayToStringArray = lStringArr
End Function
Hack
Return a singleton array containing an empty string. Note- this isn't what we want. We want an empty array- such that looping over it is like doing nothing. But a singleton array containing an empty string will often work e.g. if we later want to join all the strings together in the string array.
Public Function mVariantArrayToStringArray(pVariants() As Variant) As String()
Dim lStringArr() As String
Dim lMaxIndex As Long, lMinIndex As Long
lMaxIndex = UBound(pVariants)
lMinIndex = LBound(pVariants)
If lMaxIndex < 0 Then
ReDim lStringArr(1)
lStringArr(1) = ""
Else
ReDim lStringArr(lMaxIndex)
End If
Dim lVal As Variant
Dim lIndex As Long
For lIndex = lMinIndex To lMaxIndex
lStringArr(lIndex) = pVariants(lIndex)
Next
mVariantArrayToStringArray = lStringArr
End Function
Update since answer
Here is the function I'm using for converting a variant array to a string array. Comintern's solution seems more advanced and general, and I may switch to that one day if I'm still stuck coding in VBA:
Public Function mVariantArrayToStringArray(pVariants() As Variant) As String()
Dim lStringArr() As String
Dim lMaxIndex As Long, lMinIndex As Long
lMaxIndex = UBound(pVariants)
lMinIndex = LBound(pVariants)
If lMaxIndex < 0 Then
mVariantArrayToStringArray = Split(vbNullString)
Else
ReDim lStringArr(lMaxIndex)
End If
Dim lVal As Variant
Dim lIndex As Long
For lIndex = lMinIndex To lMaxIndex
lStringArr(lIndex) = pVariants(lIndex)
Next
mVariantArrayToStringArray = lStringArr
End Function
Notes
I use Option Explicit. This can't change as it safeguards the rest of the code in the module.
As noted in the comments, you can do this "natively" by calling Split on a vbNullString, as documented here:
expression - Required. String expression containing substrings and delimiters. If expression is a zero-length string(""), Split returns an empty array, that is, an array with no elements and no data.
If you need a more general solution (i.e., other data types, you can call the SafeArrayRedim function in oleaut32.dll directly and request that it re-dimensions the passed array to 0 elements. You do have to jump through a couple of hoops to get the base address of the array (this is due to a quirk of the VarPtr function).
In the module declarations section:
'Headers
Private Type SafeBound
cElements As Long
lLbound As Long
End Type
Private Const VT_BY_REF = &H4000&
Private Const PVDATA_OFFSET = 8
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, _
ByVal length As Long)
Private Declare Sub SafeArrayRedim Lib "oleaut32" (ByVal psa As LongPtr, _
ByRef rgsabound As SafeBound)
The procedure - pass it an initialized array (any type) and it will remove all elements from it:
Private Sub EmptyArray(ByRef vbArray As Variant)
Dim vtype As Integer
CopyMemory vtype, vbArray, LenB(vtype)
Dim lp As LongPtr
CopyMemory lp, ByVal VarPtr(vbArray) + PVDATA_OFFSET, LenB(lp)
If Not (vtype And VT_BY_REF) Then
CopyMemory lp, ByVal lp, LenB(lp)
Dim bound As SafeBound
SafeArrayRedim lp, bound
End If
End Sub
Sample usage:
Private Sub Testing()
Dim test() As Long
ReDim test(0)
EmptyArray test
Debug.Print LBound(test) '0
Debug.Print UBound(test) '-1
End Sub
Per Comintern's comment.
Make a dedicated utility function that returns the result of the VBA.Strings.Split function, working off vbNullString, which is effectively a null string pointer, which makes the intent more explicit than using an empty string literal "", which would also work:
Public Function EmptyStringArray() As String()
EmptyStringArray = VBA.Strings.Split(vbNullString)
End Function
Now branch your function to check for the existence of keys, and return EmptyStringArray if there are none, otherwise proceed to resize your result array and convert each source element.
If we're going to use WinAPI anyway, we can also cleanly create the array from scratch using the WinAPI SafeArrayCreate function instead of redimensioning it.
Struct declarations:
Public Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type
Public Type tagVariant
vt As Integer
wReserved1 As Integer
wReserved2 As Integer
wReserved3 As Integer
pSomething As LongPtr
End Type
WinAPI declarations:
Public Declare PtrSafe Function SafeArrayCreate Lib "OleAut32.dll" (ByVal vt As Integer, ByVal cDims As Long, ByRef rgsabound As SAFEARRAYBOUND) As LongPtr
Public Declare PtrSafe Sub VariantCopy Lib "OleAut32.dll" (pvargDest As Any, pvargSrc As Any)
Public Declare PtrSafe Sub SafeArrayDestroy Lib "OleAut32.dll"(ByVal psa As LongPtr)
Use it:
Public Sub Test()
Dim bounds As SAFEARRAYBOUND 'Defaults to lower bound 0, 0 items
Dim NewArrayPointer As LongPtr 'Pointer to hold unmanaged string array
NewArrayPointer = SafeArrayCreate(vbString, 1, bounds)
Dim tagVar As tagVariant 'Unmanaged variant we can manually manipulate
tagVar.vt = vbArray + vbString 'Holds a string array
tagVar.pSomething = NewArrayPointer 'Make variant point to the new string array
Dim v As Variant 'Actual variant
VariantCopy v, ByVal tagVar 'Copy unmanaged variant to managed one
Dim s() As String 'Managed string array
s = v 'Copy the array from the variant
SafeArrayDestroy NewArrayPointer 'Destroy the unmanaged SafeArray, leaving the managed one
Debug.Print LBound(s); UBound(s) 'Prove the dimensions are 0 and -1
End Sub
SafeArrayCreateVector
One other option, mentioned in answers elsewhere,1 2 3 is with SafeArrayCreateVector. While SafeArrayCreate returns a pointer as shown by Erik A, this one returns an array directly. You'd need a declaration for each type, like this:
Private Declare PtrSafe Function VectorBoolean Lib "oleaut32" Alias "SafeArrayCreateVector" ( _
Optional ByVal vt As VbVarType = vbBoolean, Optional ByVal lLow As Long = 0, Optional ByVal lCount As Long = 0) _
As Boolean()
Private Declare PtrSafe Function VectorByte Lib "oleaut32" Alias "SafeArrayCreateVector" ( _
Optional ByVal vt As VbVarType = vbByte, Optional ByVal lLow As Long = 0, Optional ByVal lCount As Long = 0) _
As Byte()
The same works for Currency, Date, Double, Integer, Long, LongLong, Object, Single, String and Variant.
If you're willing to stuff those into a module, you can create a function that works just like Array() but with an initial argument that sets the type:
Function ArrayTyped(vt As VbVarType, ParamArray argList()) As Variant
Dim ub As Long: ub = UBound(argList) + 1
Dim ret As Variant 'a variant to hold the array to be returned
Select Case vt
Case vbBoolean: Dim bln() As Boolean: bln = VectorBoolean(, , ub): ret = bln
Case vbByte: Dim byt() As Byte: byt = VectorByte(, , ub): ret = byt
Case vbCurrency: Dim cur() As Currency: cur = VectorCurrency(, , ub): ret = cur
Case vbDate: Dim dat() As Date: dat = VectorDate(, , ub): ret = dat
Case vbDouble: Dim dbl() As Double: dbl = VectorDouble(, , ub): ret = dbl
Case vbInteger: Dim i() As Integer: i = VectorInteger(, , ub): ret = i
Case vbLong: Dim lng() As Long: lng = VectorLong(, , ub): ret = lng
Case vbLongLong: Dim ll() As LongLong: ll = VectorLongLong(, , ub): ret = ll
Case vbObject: Dim obj() As Object: obj = VectorObject(, , ub): ret = obj
Case vbSingle: Dim sng() As Single: sng = VectorSingle(, , ub): ret = sng
Case vbString: Dim str() As String: str = VectorString(, , ub): ret = str
End Select
Dim argIndex As Long
For argIndex = 0 To ub - 1
ret(argIndex) = argList(argIndex)
Next
ArrayTyped = ret
End Function
This gives empty or filled arrays, like Array(). For example:
Dim myLongs() as Long
myLongs = ArrayTyped(vbLong, 1,2,3) '<-- populated Long(0,2)
Dim Pinnochio() as String
Pinnochio = ArrayTyped(vbString) '<-- empty String(0,-1)
Same ArrayTyped() Function With SafeArrayRedim
I like this function, but all those API calls for each type seem bloated. It seems the same function can be done with SafeArrayRedim, and just one API call. Declared as such:
Private Declare PtrSafe Function PtrRedim Lib "oleaut32" Alias "SafeArrayRedim" (ByVal arr As LongPtr, ByRef dims As Any) As Long
The same ArrayTyped function could then look like this:
Function ArrayTyped(vt As VbVarType, ParamArray argList()) As Variant
Dim ub As Long: ub = UBound(argList) + 1
Dim ret As Variant 'a variant to hold the array to be returned
Select Case vt
Case vbBoolean: Dim bln() As Boolean: ReDim bln(0): PtrRedim Not Not bln, ub: ret = bln
Case vbByte: Dim byt() As Byte: ReDim byt(0): PtrRedim Not Not byt, ub: ret = byt
Case vbCurrency: Dim cur() As Currency: ReDim cur(0): PtrRedim Not Not cur, ub: ret = cur
Case vbDate: Dim dat() As Date: ReDim dat(0): PtrRedim Not Not dat, ub: ret = dat
Case vbDouble: Dim dbl() As Double: ReDim dbl(0): PtrRedim Not Not dbl, ub: ret = dbl
Case vbInteger: Dim i() As Integer: ReDim i(0): PtrRedim Not Not i, ub: ret = i
Case vbLong: Dim lng() As Long: ReDim lng(0): PtrRedim Not Not lng, ub: ret = lng
Case vbLongLong: Dim ll() As LongLong: ReDim ll(0): PtrRedim Not Not ll, ub: ret = ll
Case vbObject: Dim obj() As Object: ReDim obj(0): PtrRedim Not Not obj, ub: ret = obj
Case vbSingle: Dim sng() As Single: ReDim sng(0): PtrRedim Not Not sng, ub: ret = sng
Case vbString: Dim str() As String: ReDim str(0): PtrRedim Not Not str, ub: ret = str
Case vbVariant: Dim var() As Variant: ReDim var(0): PtrRedim Not Not var, ub: ret = var
End Select
Dim argIndex As Long
For argIndex = 0 To ub - 1
ret(argIndex) = argList(argIndex)
Next
ArrayTyped = ret
End Function
A couple of other resources:
Following logic here you can also do this with user defined types. Just add another API call like the others. More discussion here.
If anyone wants empties with multiple dimensions, there is another interesting approach using SafeArrayCreate here.
What you can do is declare a variable length array of whatever type you need by declaring it with no specified length in the Dim. Then call IsArray with the array variable. It will return True but we're not interested in that, this just initialises the array.
Dim lStringArr() As String
' Call IsArray to initialise the array
IsArray lStringArr
' Print the amount of elements in the array to the Immediate window
Debug.Print UBound(lStringArr) - LBound(lStringArr) + 1
' It should print 0 without errors
So my code is setting up to send an email with all the lines that meet a certain cell name (Missing Text). if there are none of those in the search i want it to bypass and enter in a "None". If there are cells that have it, it works great, but if there is none i get a Subscript out o range error.
Dim MissingText() As Variant
Dim WrongNum() As Variant
Dim BlankText() As Variant
Dim objOutlook As Object
Dim objMsg As Object
Set objOutlook = CreateObject("Outlook.Application")
Erase MissingText, WrongNum, BlankText
Listed = 0
Ending = Cells(Rows.Count, 5).End(xlUp).Row
n = 0
For Listed = 2 To Ending
If Cells(Listed, 10).Value = "Missing Text" Then
ReDim Preserve MissingText(n)
MissingText(n) = Listed
n = n + 1
End If
Next Listed
If IsEmpty(MissingText) Then
MissingTogether = "None"
GoTo MissingSkip
End If
CountArray = UBound(MissingText, 1) - LBound(MissingText, 1) + 1
CountArray = CountArray - 1
MissingTogether = Join(MissingText, ", ")
MissingSkip:
(continues on )
At the CountArray = UBound(MissingText, 1) - LBound(MissingText, 1) + 1 is when the error occurs. any help would be nice, thank you.
As pointed out in the comments, there isn't a native way to determine if an array is uninitialized in VBA. However, you can examine its memory footprint to see if its variable contains a null pointer. Note that VarPtr throws a type mismatch for arrays, so it needs to be wrapped in a Variant first:
'In declarations section:
#If VBA7 Then
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, _
ByVal length As Long)
#Else
Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, _
ByVal length As Long)
#End If
Private Const VT_BY_REF As Integer = &H4000&
Private Const DATA_OFFSET As Long = 8
Private Function IsUninitializedArray(SafeArray As Variant) As Boolean
If Not IsArray(SafeArray) Then
Exit Function
End If
Dim vtype As Integer
'First 2 bytes are the VARENUM.
CopyMemory vtype, SafeArray, LenB(vtype)
#If VBA7 Then
Dim lp As LongPtr
#Else
Dim lp As Long
#End If
'Get the data pointer.
CopyMemory lp, ByVal VarPtr(SafeArray) + DATA_OFFSET, LenB(lp)
'Make sure the VARENUM is a pointer.
If (vtype And VT_BY_REF) <> 0 Then
'Dereference it for the actual data address.
CopyMemory lp, ByVal lp, LenB(lp)
IsUninitializedArray = lp <> 0
End If
End Function
Usage example:
Public Sub Example()
Dim Test() As String
MsgBox IsUninitializedArray(Test) 'False
Test = Split(vbNullString)
MsgBox IsUninitializedArray(Test) 'True
Erase Test
MsgBox IsUninitializedArray(Test) 'False
End Sub
I will use a string variable and split() it.
dim strMissing as string, aryMissing as variant
For Listed = 2 To Ending
If Cells(Listed, 10).Value = "Missing Text" Then
strMissing = Listed & ", " & strMissing
End If
Next Listed
If strMissing = "" then
MissingTogether = "None"
GoTo MissingSkip
else
aryMissing = split(strMissing, ", ")
CountArray = UBound(MissingText, 1) - LBound(MissingText, 1) + 1
End If
I'm working out the old Visual Basic 6.0 project. I know a bit about Visual Basic but still can't feel the difference between VB6.0 and .Net.
What I try to do:
Private sbox() As Byte = {&H63, &H7C, &H77, ... , &H7B}
But VB6.0 give an error: Unknown symbol (about { bracket)
I can do just
Private sbox() As Byte
sbox = &H63
or
sbox(0) = &H63
But it is 255 values here! Can I assign it in one line as in .NET or I just need to make this:
sbox(0) = &H63
sbox(1) = &H7C
' ... 253 lines of the same code
sbox(255) = &H00
There is no array initialisation syntax in VB6/VBA.
Depending on your needs you can:
Use Array() - but this will return an array of variants:
Dim sbox() As Variant: sbox = Array(&H63, &H7C, &H77, ..., &H7B)
Or use a helper which will return a strongly typed array:
Dim sbox() As Byte: sbox = ByteArray(&H63, &H7C, &H77, ..., &H7B)
...
Private Function ByteArray(ParamArray values() As Variant) As Byte()
ReDim bytes(UBound(values)) As Byte
Dim i As Long
For i = 0 To UBound(values)
bytes(i) = values(i)
Next
ByteArray = bytes
End Function
Or dump the raw bytes to a file, include that file as a custom resource (.res/resource add-in) and from then on:
Dim sbox() As Byte: sbox = LoadResData(101, "SBOX_VALS")
The answer by Alex is a good one. I would just add that many times when I have a long repetitive series of programming statements to enter, I usually will create a simple spreadsheet to auto-generate the lines.
i.e., in Excel, put your values in column A, then in column B put =CONCATENATE(...) statements to form up the VB6 code. Finally, copy/paste as text into your IDE.
There are many ways to skin this cat, though for large Byte arrays a custom resource may make more sense. Here is one example:
Option Explicit
Private Const WIN32_NULL As Long = 0
Private Const WIN32_FALSE As Long = 0
Private Enum CS_FLAGS
CRYPT_STRING_HEX = &H4&
End Enum
Private Declare Function CryptStringToBinary Lib "Crypt32" _
Alias "CryptStringToBinaryW" ( _
ByVal pszString As Long, _
ByVal cchString As Long, _
ByVal dwFlags As CS_FLAGS, _
ByVal pbBinary As Long, _
ByRef cbBinary As Long, _
ByVal pdwSkip As Long, _
ByRef dwFlagsActual As CS_FLAGS) As Long
Private Sub HexToBytes(ByRef HexData As String, ByRef Bytes() As Byte)
Dim OutLen As Long
Dim dwActualUsed As CS_FLAGS
OutLen = UBound(Bytes) - LBound(Bytes) + 1
If CryptStringToBinary(StrPtr(HexData), _
Len(HexData), _
CRYPT_STRING_HEX, _
VarPtr(Bytes(LBound(Bytes))), _
OutLen, _
WIN32_NULL, _
dwActualUsed) = WIN32_FALSE Then
Err.Raise &H8004A700, _
"HexToBytes", _
"CryptStringToBinary failed, error " & CStr(Err.LastDllError)
End If
End Sub
Private Sub Form_Load()
Const EXAMPLE_ONE As String = "41 42 43 44 45 46 47 48"
Const EXAMPLE_TWO As String = _
"4C6F72656D20697073756D20646F6C6F722073697420616D65742C20636F6E73" _
& "656374657475720D0A61646970697363696E6720656C69742E20557420696E20" _
& "75726E6120677261766964612C0D0A68656E647265726974206D69206E6F6E2C" _
& "20666163696C6973697320616E74652E0D0A0D0A41656E65616E20616320656E" _
& "696D2074656D7075732C206C6163696E69612070757275730D0A717569732C20" _
& "766F6C75747061742076656C69742E2053757370656E64697373652071756973" _
& "0D0A636F6D6D6F646F206E6962682E204E616D206574206C696265726F206575" _
& "206C65637475730D0A73616769747469732072686F6E6375732E2E2E2E2E2E21"
Dim One(1 To 8) As Byte
Dim Two(0 To 255) As Byte
AutoRedraw = True
HexToBytes EXAMPLE_ONE, One
Print UBound(One) - LBound(One) + 1; ":"
Print StrConv(One, vbUnicode)
HexToBytes EXAMPLE_TWO, Two
Print UBound(Two) - LBound(Two) + 1; ":"
Print StrConv(Two, vbUnicode)
End Sub
I found one more way to solve this task:
Private sbox() As Byte
ReDim sbox(255)
Dim i As Integer
For i = 0 To 255
sbox(i) = Choose(i + 1, &H63, &H7C, _
..., &H00)
Next
There are two interesting moments here:
We still need to know actual array size: as you see I used 255 in couple of lines
Its a good point to use _ to write this statement in several lines: for example, I wrote data by 16 values in line in hex, so it is easy to read now.
I'm using callByName I VBA to dynamically call different methods of a class. Depending on the method, I will have a different number of arguments which will be held in an array. Unfortunately CallByName accepts a param array, therefore it's not straightforward to pass a variable number. Is there a way around this, I found a solution using the Type Information Library but this does not seem to work on VBA even though I have added it as a reference. Below is an illustration of what I want
Public Sub Initialize_Object(ByRef TaskObject, Task_Collection)
Dim Task_begin As Variant, Method_Parameters As Variant
Task_begin = Task_Collection("Method")
CallByName TaskObject, Task_begin, VbMethod, Method_Parameters
You could use CallByName with an array as argument by changing the method signature :
#If VBA7 Or Win64 Then
Private Declare PtrSafe Function rtcCallByName Lib "VBE7.DLL" ( _
ByVal Object As Object, _
ByVal ProcName As LongPtr, _
ByVal CallType As VbCallType, _
ByRef args() As Any, _
Optional ByVal lcid As Long) As Variant
#Else
Private Declare Function rtcCallByName Lib "VBE6.DLL" ( _
ByVal Object As Object, _
ByVal ProcName As Long, _
ByVal CallType As VbCallType, _
ByRef args() As Any, _
Optional ByVal lcid As Long) As Variant
#End If
Public Function CallByName2(Object As Object, ProcName As String, args() As Variant)
AssignResult CallByName2, rtcCallByName(Object, StrPtr(ProcName), VbMethod, args)
End Function
Private Sub AssignResult(target, result)
If VBA.IsObject(result) Then Set target = result Else target = result
End Sub
Here is a usage example:
Sub UsageExample()
Dim obj As Object, arguments()
Dim obj As New Class1
arguments = Array(1, 3)
CallByName2 obj, "MyMethod", arguments
End Sub
You can't do this dynamically because different methods will require a different amount of arguments and you can't pass arguments where they aren't expected.
If you know the amount of arguments required, then you could call each item of the array and pass that:
CallByName TaskObject, Task_begin, VbMethod, Method_Parameters(0), Method_Parameters(1), Method_Parameters(2)
but you would probably have to set up a Select Case block or similar to handle all the different methods:
Select Case Method_Name
Case "Method_1": CallByName TaskObject, Task_begin, VbMethod, Method_Parameters(0), Method_Parameters(1)
Case "Method_2": CallByName TaskObject, Task_begin, VbMethod, Method_Parameters(0)
Case "Method_3": CallByName TaskObject, Task_begin, VbMethod, Method_Parameters(0), Method_Parameters(1), Method_Parameters(2)
End Select
Which can get messy quite easily.
I'm trying to load a file in a VBA macro that has been copied from, say, an Explorer window.
I can easily get the data from the clipboard using DataObject::GetFromClipboard, but the VBA interface to DataObject doesn't seem to have methods for working with any other formats than plain text. There are only GetText and SetText methods.
If I can't get a file stream directly from the DataObject, the filename(s) would also do, so maybe GetText could be forced to return the name of a file placed on the clipboard?
There is very little documentation to be found for VBA anywhere. :(
Maybe someone could point me to an API wrapper class for VBA that has this sort of functionality?
This works for me (in a module);
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal uFormat As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal uFormat As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal drop_handle As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Private Const CF_HDROP As Long = 15
Public Function GetFiles(ByRef fileCount As Long) As String()
Dim hDrop As Long, i As Long
Dim aFiles() As String, sFileName As String * 1024
fileCount = 0
If Not CBool(IsClipboardFormatAvailable(CF_HDROP)) Then Exit Function
If Not CBool(OpenClipboard(0&)) Then Exit Function
hDrop = GetClipboardData(CF_HDROP)
If Not CBool(hDrop) Then GoTo done
fileCount = DragQueryFile(hDrop, -1, vbNullString, 0)
ReDim aFiles(fileCount - 1)
For i = 0 To fileCount - 1
DragQueryFile hDrop, i, sFileName, Len(sFileName)
aFiles(i) = Left$(sFileName, InStr(sFileName, vbNullChar) - 1)
Next
GetFiles = aFiles
done:
CloseClipboard
End Function
Use:
Sub wibble()
Dim a() As String, fileCount As Long, i As Long
a = GetFiles(fileCount)
If (fileCount = 0) Then
MsgBox "no files"
Else
For i = 0 To fileCount - 1
MsgBox "found " & a(i)
Next
End If
End Sub
Save the files if they are in the clipboard to the destination folder.
Public Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Public Const CF_HDROP As Long = 15
Public Function SaveFilesFromClipboard(DestinationFolder As String) As Boolean
SaveFilesFromClipboard = False
If Not CBool(IsClipboardFormatAvailable(CF_HDROP)) Then Exit Function
CreateObject("Shell.Application").Namespace(CVar(DestinationFolder)).self.InvokeVerb "Paste"
SaveFilesFromClipboard = True
End Function
Seems like a strange way to try to get at the textfile. The DataObject class is only for working with text strings to and from the clipboard.
Here is a very good resource of that:
http://www.cpearson.com/excel/Clipboard.aspx
If your wanting to get a file stream of a file you can look into the FileSystemObject and TextStream Classes.