S
slsman
Guest
The debug message is as follows: also note the error on the bottom of the debug message
Option Compare Database
Sub VerifyDBPixSetup()
If DBPixInstallRequired Then
DoCmd.OpenForm "_DoDBPixInstall", acNormal, , , , acDialog
End If
End Sub
Public Function DBPixInstallRequired() As Boolean
' See if DBPix registry key exists - if not DBPix install is required
Dim DBPixRegKey As String
Dim DBPixRegValue As String
DBPixInstallRequired = False
DBPixRegKey = "CLSID\{58444091-851A-46BC-BA63-904886070C0D}\InprocServer32"
DBPixRegValue = fReturnRegKeyValue(HKEY_CLASSES_ROOT, DBPixRegKey, "")
If IsEmpty(DBPixRegValue) Or DBPixRegValue = "" Then
DBPixInstallRequired = True
End If
End Function
Sub InstallDBPix(BlobData As Variant)
Dim Result As Long
Dim FileName As String
Dim FileNameQuoted As String
Dim File As String
FileName = GetDBFolder & "dbps_tmp.exe"
Result = DeletOldFile(FileName)
Result = BlobToFile(FileName, BlobData)
If Dir$(FileName) <> vbNullString Then
' Optional - run the setup in 'Silent' mode.
' Warning ! In silent mode users could open forms/reports before the installation has completed, which would cause an error.
' FileName = FileName + " -s -a -s"
Shell (FileName)
' ShellWait (FileName) 'Synchronous alternative (but seams to deadlock on XP test system)
End If
End Sub
Public Function DeletOldFile(sFile As String) As Long
On Error GoTo DeletOldFile_Err
Dim nFileNum As Integer
' Make sure the file is creatable and does not already exist
' as a protected file
If Dir$(sFile) <> vbNullString Then
If GetAttr(sFile) And (vbSystem + vbDirectory + vbReadOnly) Then
'
' Cannot overwrite in these cases
DeletOldFile = False
Exit Function
End If
Kill sFile
DeletOldFile = True
End If
DeletOldFile_Err:
DeletOldFile = False
Exit Function
End Function
Public Function BlobToFile(sFile As String, BlobData As Variant) As Long
Dim nFileNum As Integer
Dim abytData() As Byte
BlobToFile = 0
nFileNum = FreeFile
On Error Resume Next
Open sFile For Binary Access Write As nFileNum
Select Case Err
Case 0
sDataOut = BlobData
abytData = sDataOut
Put #nFileNum, , abytData
BlobToFile = LOF(nFileNum)
Case 70
BlobToFile = 0
Case Else
BlobToFile = 0
End Select
On Error GoTo 0
Close nFileNum
End Function
Public Function GetDBFolder() As String
Dim DBFullPath As String
Dim i As Integer
DBFullPath = CurrentDb().Name
' Strip the filename from the full path
For i = 1 To Len(DBFullPath)
If Mid(DBFullPath, i, 1) = "\" Then
GetDBFolder = Left(DBFullPath, i)
End If
Next
End Function
within the following, "shellwait (Filename)" is highlighted.
If Dir$(FileName) <> vbNullString Then
' Optional - run the setup in 'Silent' mode.
' Warning ! In silent mode users could open forms/reports before the installation has completed, which would cause an error.
' FileName = FileName + " -s -a -s"
Shell (FileName)
' ShellWait (FileName) 'Synchronous alternative (but seams to deadlock on XP test system)
End If
Continue reading...
Option Compare Database
Sub VerifyDBPixSetup()
If DBPixInstallRequired Then
DoCmd.OpenForm "_DoDBPixInstall", acNormal, , , , acDialog
End If
End Sub
Public Function DBPixInstallRequired() As Boolean
' See if DBPix registry key exists - if not DBPix install is required
Dim DBPixRegKey As String
Dim DBPixRegValue As String
DBPixInstallRequired = False
DBPixRegKey = "CLSID\{58444091-851A-46BC-BA63-904886070C0D}\InprocServer32"
DBPixRegValue = fReturnRegKeyValue(HKEY_CLASSES_ROOT, DBPixRegKey, "")
If IsEmpty(DBPixRegValue) Or DBPixRegValue = "" Then
DBPixInstallRequired = True
End If
End Function
Sub InstallDBPix(BlobData As Variant)
Dim Result As Long
Dim FileName As String
Dim FileNameQuoted As String
Dim File As String
FileName = GetDBFolder & "dbps_tmp.exe"
Result = DeletOldFile(FileName)
Result = BlobToFile(FileName, BlobData)
If Dir$(FileName) <> vbNullString Then
' Optional - run the setup in 'Silent' mode.
' Warning ! In silent mode users could open forms/reports before the installation has completed, which would cause an error.
' FileName = FileName + " -s -a -s"
Shell (FileName)
' ShellWait (FileName) 'Synchronous alternative (but seams to deadlock on XP test system)
End If
End Sub
Public Function DeletOldFile(sFile As String) As Long
On Error GoTo DeletOldFile_Err
Dim nFileNum As Integer
' Make sure the file is creatable and does not already exist
' as a protected file
If Dir$(sFile) <> vbNullString Then
If GetAttr(sFile) And (vbSystem + vbDirectory + vbReadOnly) Then
'
' Cannot overwrite in these cases
DeletOldFile = False
Exit Function
End If
Kill sFile
DeletOldFile = True
End If
DeletOldFile_Err:
DeletOldFile = False
Exit Function
End Function
Public Function BlobToFile(sFile As String, BlobData As Variant) As Long
Dim nFileNum As Integer
Dim abytData() As Byte
BlobToFile = 0
nFileNum = FreeFile
On Error Resume Next
Open sFile For Binary Access Write As nFileNum
Select Case Err
Case 0
sDataOut = BlobData
abytData = sDataOut
Put #nFileNum, , abytData
BlobToFile = LOF(nFileNum)
Case 70
BlobToFile = 0
Case Else
BlobToFile = 0
End Select
On Error GoTo 0
Close nFileNum
End Function
Public Function GetDBFolder() As String
Dim DBFullPath As String
Dim i As Integer
DBFullPath = CurrentDb().Name
' Strip the filename from the full path
For i = 1 To Len(DBFullPath)
If Mid(DBFullPath, i, 1) = "\" Then
GetDBFolder = Left(DBFullPath, i)
End If
Next
End Function
within the following, "shellwait (Filename)" is highlighted.
If Dir$(FileName) <> vbNullString Then
' Optional - run the setup in 'Silent' mode.
' Warning ! In silent mode users could open forms/reports before the installation has completed, which would cause an error.
' FileName = FileName + " -s -a -s"
Shell (FileName)
' ShellWait (FileName) 'Synchronous alternative (but seams to deadlock on XP test system)
End If
Continue reading...