Having nothing better to do today, I decided to do something that apparently
only Michael Kaplan knows how to do (and cannot disclose due to legal
reasons).
My method is really nothing more than a stupid cheat, embedding the whole
binary contents of the file in vba code, but who needs more? It seems to
create the file quickly and reliably and avoids using an OLE field in a
table to do this (which some people don't like). Apart from the slightly
large module size, I can't see any reason to avoid this method. Does anyone
care to comment?
Public Function CreateWorkgroup (strPath As String) As Boolean
On Error GoTo Err_Handler
Dim a(0 To 3327) As String
Dim lngCount As Long
Dim strData As String
Dim intFile As Integer
a(0) =
"000100004A6574 2053797374656D2 044422020000100 0000B56E0362600 9C255"
a(1) =
"E9A96772403F00 9C7E9F90FF859A3 1C57FBAED30BBDF CC9D63D9E4C39F4 6AE38"
a(2) =
"4BEE7A6DEC37A1 D29CFA3AC828E6E F208A60A8027B36 09E4DFB18B62134 33339"
<snip><snip><sn ip><snip><snip> <snip>
a(3327) =
"6A2EED6AD8861A 1B71052B9CFACCE 699FC170E04EC32 CD1D855E70B4CF6 E38D7"
For lngCount = 0 To 3327
strData = strData & ConvertHex(a(ln gCount))
Next lngCount
intFile = FreeFile
Open strPath For Binary As intFile
Put intFile, , strData
Close intFile
CreateWorkgroup = True
Exit_Handler:
Exit Function
Err_Handler:
MsgBox Err.Description , vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Function
Private Function ConvertHex(strC ode As String) As String
Dim lngPos As Long
Dim strData As String
Dim str As String
If Len(strCode) > 1 Then
If Len(strCode) Mod 2 = 0 Then
lngPos = 1
Do While lngPos < Len(strCode)
strData = strData & Chr$(CLng("&H" & Mid$(strCode, lngPos,
2)))
lngPos = lngPos + 2
Loop
End If
End If
ConvertHex = strData
End Function
only Michael Kaplan knows how to do (and cannot disclose due to legal
reasons).
My method is really nothing more than a stupid cheat, embedding the whole
binary contents of the file in vba code, but who needs more? It seems to
create the file quickly and reliably and avoids using an OLE field in a
table to do this (which some people don't like). Apart from the slightly
large module size, I can't see any reason to avoid this method. Does anyone
care to comment?
Public Function CreateWorkgroup (strPath As String) As Boolean
On Error GoTo Err_Handler
Dim a(0 To 3327) As String
Dim lngCount As Long
Dim strData As String
Dim intFile As Integer
a(0) =
"000100004A6574 2053797374656D2 044422020000100 0000B56E0362600 9C255"
a(1) =
"E9A96772403F00 9C7E9F90FF859A3 1C57FBAED30BBDF CC9D63D9E4C39F4 6AE38"
a(2) =
"4BEE7A6DEC37A1 D29CFA3AC828E6E F208A60A8027B36 09E4DFB18B62134 33339"
<snip><snip><sn ip><snip><snip> <snip>
a(3327) =
"6A2EED6AD8861A 1B71052B9CFACCE 699FC170E04EC32 CD1D855E70B4CF6 E38D7"
For lngCount = 0 To 3327
strData = strData & ConvertHex(a(ln gCount))
Next lngCount
intFile = FreeFile
Open strPath For Binary As intFile
Put intFile, , strData
Close intFile
CreateWorkgroup = True
Exit_Handler:
Exit Function
Err_Handler:
MsgBox Err.Description , vbExclamation, "Error No: " & Err.Number
Resume Exit_Handler
End Function
Private Function ConvertHex(strC ode As String) As String
Dim lngPos As Long
Dim strData As String
Dim str As String
If Len(strCode) > 1 Then
If Len(strCode) Mod 2 = 0 Then
lngPos = 1
Do While lngPos < Len(strCode)
strData = strData & Chr$(CLng("&H" & Mid$(strCode, lngPos,
2)))
lngPos = lngPos + 2
Loop
End If
End If
ConvertHex = strData
End Function
Comment