Further adventures in migrating to 64 bit

[LanaR]

I have the following code under a button, which opens the file explorer window, and then moves the selected document to the target file and notes its location in the DB. In 64 bit the file explorer windows does not open and the MsgBox "File selection was canceled.", vbInformation is shown

Private Sub Command115_Click()

On Error GoTo Err_bBrowse_Click
  
'check if tasting note already attached
'if no note then add PDF Location

   If Me.tbFile = "" Or IsNull(Me.tbFile) Then
  
  
    Dim strFilter As String
    Dim lngFlags As Long
    Dim varFileName As Variant



'   strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
'    & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
'    strFilter = "Access Files (*.mdb)" & vbNullChar & "*.mdb*"
    strFilter = "All Files (*.*)" & vbNullChar & "*.*"

    lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly

    varFileName = tsGetFileFromUser( _
    fOpenFile:=True, _
    strFilter:=strFilter, _
    rlngflags:=lngFlags, _
    strInitialDir:="C:\Windows\", _
    strDialogTitle:="Find File (Select The File And Click The Open Button)")
    'remove the strInitialDir:="C:\Windows\", _ line if you do not want the Browser to open at a specific location

    If IsNull(varFileName) Or varFileName = "" Then
        Debug.Print "User pressed 'Cancel'."
        Beep
        MsgBox "File selection was canceled.", vbInformation
        Exit Sub
    Else
        'Debug.Print varFileName
        tbFile = varFileName
        
        
' Additional procedure to move file to correct destination

            Dim sSource As String
            Dim sTarget As String
            Dim sFName As String
            
            
            
            
            'Set File Source
            sSource = Me.tbFile
            
            'Determine the the Name of the file to be moved
            sFName = Mid(sSource, InStrRev(sSource, "\"), Len(sSource) - (InStrRev(sSource, "\") - 1))
            
        
            'Set File destination
            sTarget = "C:\MS Office Data\PDF\WineTastingNotes" & sFName
            
            
        
            
            'Copy file to destination
            VBA.FileCopy sSource, sTarget
            
            'Set cirrect location for file
            Me.tbFile = sTarget
            
            'Delete Original
            VBA.Kill sSource
            
            
'Additional Procedure to append Remark to tasting Notes
    
    Dim StrSQL As String
    
    StrSQL = "INSERT INTO TBL_TastNote ( WineID, AuthID, [Note] ) " & _
            "SELECT TBL_Wine.WineID, 4 AS Expr1, 'See Attatched PDF' AS Expr2 " & _
            "FROM TBL_Wine " & _
            "WHERE (((TBL_Wine.WineID)=[forms]![FRM_Wine]![WineID])); "
    

   DoCmd.RunSQL StrSQL
        
        
        
    End If

    'Call ParseFileName  <= this was in original code but caused an error
    
    
    'Change caption of Button and make PDF Icon visible
    Me.Command115.Caption = "View PDF Tasting Note"
    Me.OLEUnbound119.Visible = True


'if Notes already attached
'View note
    Else
    
        OpenFile (tbFile)
        
    End If


Exit_bBrowse_Click:
    Exit Sub

Err_bBrowse_Click:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_bBrowse_Click

End Sub

 

[arnelgp]

you upload your db so someone can convert it to x64 code.

 

[LanaR]

Sorry, it's too big. I suspect the problem lies in this portion of the code;

varFileName = tsGetFileFromUser( _
    fOpenFile:=True, _
    strFilter:=strFilter, _
    rlngflags:=lngFlags, _
    strInitialDir:="C:\Windows\", _
    strDialogTitle:="Find File (Select The File And Click The Open Button)")
    'remove the strInitialDir:="C:\Windows\", _ line if you do not want the Browser to open at a specific location

as varFileName is returning a null value

 

[arnelgp]

i found it on the net.
test and replace your code with this one:
there is a test sub(), run it.

' converted by arnelgp
' for x64 compatible
'
#If VBA7 Then
    Type tsFileName
        lStructSize As Long
        hwndOwner As LongPtr
        hInstance As LongPtr
        strFilter As String
        strCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        strFile As String
        nMaxFile As Long
        strFileTitle As String
        nMaxFileTitle As Long
        strInitialDir As String
        strTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        strDefExt As String
        lCustData As Long
        lpfnHook As LongPtr
        lpTemplateName As String
    '#if (_WIN32_WINNT >= 0x0500)
        pvReserved As LongPtr
        dwReserved As Long
        FlagsEx As Long
    '#endif // (_WIN32_WINNT >= 0x0500)
    End Type
#Else
    Type tsFileName
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        strFilter As String
        strCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        strFile As String
        nMaxFile As Long
        strFileTitle As String
        nMaxFileTitle As Long
        strInitialDir As String
        strTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        strDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
    End Type
#End If

#If VBA7 Then
    Declare PtrSafe Function ts_apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (tsFN As tsFileName) As Long
    Declare PtrSafe Function ts_apiGetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (tsFN As tsFileName) As Long
    Private Declare PtrSafe Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
#Else
    Declare Function ts_apiGetOpenFileName Lib "comdlg32.dll" _
        Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean
        
    Declare Function ts_apiGetSaveFileName Lib "comdlg32.dll" _
        Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean
    Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
#End If
' Flag Constants
Public Const tscFNAllowMultiSelect = &H200
Public Const tscFNCreatePrompt = &H2000
Public Const tscFNExplorer = &H80000
Public Const tscFNExtensionDifferent = &H400
Public Const tscFNFileMustExist = &H1000
Public Const tscFNPathMustExist = &H800
Public Const tscFNNoValidate = &H100
Public Const tscFNHelpButton = &H10
Public Const tscFNHideReadOnly = &H4
Public Const tscFNLongNames = &H200000
Public Const tscFNNoLongNames = &H40000
Public Const tscFNNoChangeDir = &H8
Public Const tscFNReadOnly = &H1
Public Const tscFNOverwritePrompt = &H2
Public Const tscFNShareAware = &H4000
Public Const tscFNNoReadOnlyReturn = &H8000
Public Const tscFNNoDereferenceLinks = &H100000

Public Function tsGetFileFromUser( _
Optional ByRef rlngflags As Long = 0&, _
Optional ByVal strInitialDir As String = "", _
Optional ByVal strFilter As String = "All Files (*.*)" & vbNullChar & "*.*", _
Optional ByVal lngFilterIndex As Long = 1, _
Optional ByVal strDefaultExt As String = "", _
Optional ByVal strFileName As String = "", _
Optional ByVal strDialogTitle As String = "", _
Optional ByVal fOpenFile As Boolean = True) As Variant

On Error GoTo tsGetFileFromUser_Err
Dim tsFN As tsFileName
Dim strFileTitle As String
Dim fResult As Boolean
' Allocate string space for the returned strings.
strFileName = Left(strFileName & String(256, 0), 256)
strFileTitle = String(256, 0)
' Set up the data structure before you call the function
With tsFN
    .lStructSize = Len(tsFN)
    .hwndOwner = Application.hWndAccessApp
    .strFilter = strFilter
    .nFilterIndex = lngFilterIndex
    .strFile = strFileName
    .nMaxFile = Len(strFileName)
    .strFileTitle = strFileTitle
    .nMaxFileTitle = Len(strFileTitle)
    .strTitle = strDialogTitle
    .flags = rlngflags
    .strDefExt = strDefaultExt
    .strInitialDir = strInitialDir
    .hInstance = 0
    .strCustomFilter = String(255, 0)
    .nMaxCustFilter = 255
    .lpfnHook = 0
End With

' Call the function in the windows API
If fOpenFile Then
    fResult = ts_apiGetOpenFileName(tsFN)
Else
    fResult = ts_apiGetSaveFileName(tsFN)
End If
' If the function call was successful, return the FileName chosen
' by the user. Otherwise return null. Note, the CancelError property
' used by the ActiveX Common Dialog control is not needed. If the
' user presses Cancel, this function will return Null.
If fResult Then
    rlngflags = tsFN.flags
    tsGetFileFromUser = tsTrimNull(tsFN.strFile)
Else
    tsGetFileFromUser = Null
End If

tsGetFileFromUser_End:
On Error GoTo 0
Exit Function
tsGetFileFromUser_Err:
Beep
MsgBox Err.Description, , "Error: " & Err.Number _
& " in function basBrowseFiles.tsGetFileFromUser"
Resume tsGetFileFromUser_End
End Function

' Trim Nulls from a string returned by an API call.
Private Function tsTrimNull(ByVal strItem As String) As String
    
    On Error GoTo tsTrimNull_Err
    Dim I As Integer
    
    I = InStr(strItem, vbNullChar)
    If I > 0 Then
        tsTrimNull = Left(strItem, I - 1)
    Else
        tsTrimNull = strItem
    End If
    
tsTrimNull_End:
    On Error GoTo 0
    Exit Function
tsTrimNull_Err:
    Beep
    MsgBox Err.Description, , "Error: " & Err.Number _
    & " in function basBrowseFiles.tsTrimNull"
    Resume tsTrimNull_End
End Function


Private Sub test()
Dim varFileName, strFilter As String, lngFlags As Long
lngFlags = tscFNReadOnly
strFilter = "Excel Files (*.XLSX)" & vbNullChar & "*.XLSX"
varFileName = tsGetFileFromUser( _
    fOpenFile:=True, _
    strFilter:=strFilter, _
    rlngflags:=lngFlags, _
    strInitialDir:="C:\Windows\", _
    strDialogTitle:="Find File (Select The File And Click The Open Button)")
Debug.Print varFileName
End Sub

 

[LanaR]

Thank you ever so much @arnelgp works a treat

Just had to insert the PtrSafe attribute in a couple of locations