32-bit to 64-bit function coding conversion (1 Viewer)

F

FrozenMana

Registered User.
Local time
Today, 16:47
Joined
Aug 10, 2015
Messages
27
Hello, I have yet another database which I have been assigned the task of converting from 32-bit to 64-bit.

I have used http://www.jkp-ads.com/articles/apideclarations.asp as a reference to update what I could however since I am not fully sure what the database does outside of importing a file and am not receiving the debug message.:banghead:

I have made a few changes however it results in nothing happening when I click the cmdFile button.

Below is the original coding:
Code: 
Option Compare Database

' everything from here to "' finish" is for browser button
Option Explicit

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public CDCaption, CDSearchString, CDInitDir As String

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal pidl As Long, _
            ByVal pszPath As String) As Long
            
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
            As Long
            
Private Const BIF_RETURNONLYFSDIRS = &H1

Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  LParam As Long
  iImage As Long
End Type

Sub Browser1(X)

Dim strPath As String, FilePath As Object

Select Case X
    Case 1: Set FilePath = Me.txtFile
'    Case 2: Set FilePath = txtFile2
'    Case 3: Set FilePath = txtFile3
End Select

    CDSearchString = "*.*"
 
    CDCaption = "Select File to Attach..."
    
    If IsNull(FilePath.Value) Or FilePath.Value = "" Then
        CDInitDir = "C:\"
    Else
        CDInitDir = FilePath.Value
    End If
    
    strPath = LaunchCD(Me)
    If strPath <> "None Selected" Then FilePath.Value = strPath
    
End Sub

Function LaunchCD(strForm As Form) As String
    Dim OpenFile As OPENFILENAME
    Dim lReturn As Long
    Dim sFilter As String
    
    OpenFile.lStructSize = Len(OpenFile)
    OpenFile.lpstrFile = String(257, 0)
    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
    OpenFile.lpstrTitle = "Select File..."
    lReturn = GetOpenFileName(OpenFile)
        If lReturn = 0 Then
            LaunchCD = "None Selected"
        Else
            LaunchCD = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
        End If
End Function
Public Function BrowseFolder(szDialogTitle As String) As String
  Dim X As Long, bi As BROWSEINFO, dwIList As Long
  Dim szPath As String, wPos As Integer
    
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function
Function BrowseForFolder(strComment As String, Optional OpenAt As Variant) As Variant
     'code found at: http://www.vbaexpress.com/kb/getarticle.php?kb_id=284
     'Function purpose:  To Browser for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'NOTE:  If invalid, it will open at the Desktop level
     
    Dim ShellApp As Object
     
     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, strComment, 0, OpenAt)
     
     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
     'Destroy the Shell Application
    Set ShellApp = Nothing
     
     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
     
    Exit Function
     
Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
     
End Function

Private Sub cmdFile_Click()
    Call Browser1(1)
End Sub

Private Sub cmdFolder_Click()
    Me.txtFolder = BrowseFolder("Please select the folder in which to save the individual RA's:")
End Sub

Private Sub cmdGO_Click()

'On Error GoTo ERROR_1

'Import RA File
    DoCmd.SetWarnings False
    DoCmd.RunSQL "Delete * from tblImport"
    DoCmd.SetWarnings True
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tblImport", Me.txtFile, True
'create recordset
    Dim rstX As DAO.Recordset
    Dim qdfX As QueryDef
    Dim strHub As String
    Set qdfX = CurrentDb.QueryDefs("qryTblImport")
    strHub = InputBox("Which delivery hub would you like to Export?")
    qdfX.Parameters(0) = strHub
    Set rstX = qdfX.OpenRecordset
    'rstX.MoveFirst
    Select Case rstX.RecordCount
        Case Is > 0
        Case Else
            MsgBox "You have selected an RA File which is empty. Please select a valid RA file.", vbCritical, "WARNING!"
            Exit Sub
    End Select

'create Excel Application
    Dim xlApp As Excel.Application
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Workbooks.Add
    
'On Error GoTo ERROR_2
    
'create variables to use
    Dim dteA As Date
    Dim strB As String
    Dim strC As String
    Dim strD As String
    Dim dteE As Date
    Dim strF As String
    Dim strG As String
    Dim strH As String
    Dim strI As String
    Dim strJ As String
    Dim strK As String
    Dim strL As String
    Dim dteM As Date
    Dim strN As String
    Dim strO As String
    Dim strP As String
    Dim strQ As String
    Dim strR As String
    Dim strS As String
    Dim strT As String
    Dim strU As String
    Dim strV As String
    Dim strW As String
    Dim strX As String
    Dim strY As String
'create workbook and create correct number of worksheets
    rstX.MoveLast
    rstX.MoveFirst
    Select Case rstX.RecordCount
        Case Is > xlApp.Worksheets.Count
            Do Until rstX.RecordCount = xlApp.Worksheets.Count
                xlApp.Worksheets.Add
            Loop
        Case Is < xlApp.Worksheets.Count
            Do Until rstX.RecordCount = xlApp.Worksheets.Count
                xlApp.Worksheets(xlApp.Worksheets.Count).Delete
            Loop
    End Select
'Loop through rstX and export into Excel Sheet and save workbook
    'create worksheet counting int
        Dim intX As Integer
        intX = 1
    Do Until rstX.EOF
    'fill variables
        If Not IsNull(rstX.Fields(0)) Then
            dteA = rstX.Fields(0)
        End If
        If Not IsNull(rstX.Fields(1)) Then
            strB = rstX.Fields(1)
        End If
        If Not IsNull(rstX.Fields(2)) Then
            strC = rstX.Fields(2)
        End If
        If Not IsNull(rstX.Fields(3)) Then
            strD = rstX.Fields(3)
        End If
        If Not IsNull(rstX.Fields(4)) Then
            dteE = rstX.Fields(4)
        End If
        If Not IsNull(rstX.Fields(5)) Then
            strF = rstX.Fields(5)
        End If
        If Not IsNull(rstX.Fields(6)) Then
            strG = rstX.Fields(6)
        End If
        If Not IsNull(rstX.Fields(7)) Then
            strH = rstX.Fields(7)
        End If
        If Not IsNull(rstX.Fields(8)) Then
            strI = rstX.Fields(8)
        End If
        If Not IsNull(rstX.Fields(9)) Then
            strJ = rstX.Fields(9)
        End If
        If Not IsNull(rstX.Fields(10)) Then
            strK = rstX.Fields(10)
        End If
        If Not IsNull(rstX.Fields(11)) Then
            strL = rstX.Fields(11)
        End If
        If Not IsNull(rstX.Fields(12)) Then
            dteM = rstX.Fields(12)
        End If
        If Not IsNull(rstX.Fields(13)) Then
            strN = rstX.Fields(13)
        End If
        If Not IsNull(rstX.Fields(14)) Then
            strO = rstX.Fields(14)
        End If
        If Not IsNull(rstX.Fields(15)) Then
            strP = rstX.Fields(15)
        End If
        If Not IsNull(rstX.Fields(16)) Then
            strQ = rstX.Fields(16)
        End If
        If Not IsNull(rstX.Fields(17)) Then
            strR = rstX.Fields(17)
        End If
        If Not IsNull(rstX.Fields(18)) Then
            strS = rstX.Fields(18)
        End If
        If Not IsNull(rstX.Fields(19)) Then
            strT = rstX.Fields(19)
        End If
        If Not IsNull(rstX.Fields(20)) Then
            strU = rstX.Fields(20)
        End If
        If Not IsNull(rstX.Fields(21)) Then
            strV = rstX.Fields(21)
        End If
        If Not IsNull(rstX.Fields(22)) Then
            strW = rstX.Fields(22)
        End If
        If Not IsNull(rstX.Fields(23)) Then
            strX = rstX.Fields(23)
        End If
        If Not IsNull(rstX.Fields(24)) Then
            strY = rstX.Fields(24)
        End If
    'select worksheet and format
        xlApp.Worksheets(intX).Select
        'format cells
        xlApp.Range("A1:J1").Select
        With xlApp.Selection
            .HorizontalAlignment = xlCenter
        End With
        xlApp.Selection.Merge
        xlApp.ActiveCell.FormulaR1C1 = "JCPENNEY FACTORY SHIP RETURN AUTHORIZATION"
        xlApp.Range("A3").Select
        xlApp.ActiveCell.FormulaR1C1 = "EXEL HUB:"
        xlApp.Range("A5").Select
        xlApp.ActiveCell.FormulaR1C1 = "CASE:"
        xlApp.Range("A7").Select
        xlApp.ActiveCell.FormulaR1C1 = "CONSIGNEE:"
        xlApp.Range("A9").Select
        xlApp.ActiveCell.FormulaR1C1 = "JCPENNEY ORDER #:"
        xlApp.Range("A11").Select
        xlApp.ActiveCell.FormulaR1C1 = "INVOICE DATE:"
        xlApp.Range("A13").Select
        xlApp.ActiveCell.FormulaR1C1 = "ADDRESS:"
        xlApp.Range("A15").Select
        xlApp.ActiveCell.FormulaR1C1 = "PHONE NUMBER:"
        xlApp.Range("A17").Select
        xlApp.ActiveCell.FormulaR1C1 = "NOTIFY # IF DIFFERENT:"
        xlApp.Range("A19").Select
        xlApp.ActiveCell.FormulaR1C1 = "MERCHANDISE:"
        xlApp.Range("A20").Select
        xlApp.Range("A23").Select
        xlApp.ActiveCell.FormulaR1C1 = "COMMENTS:"
        xlApp.Range("A26").Select
        xlApp.ActiveCell.FormulaR1C1 = "REASON FOR RETURN:"
        xlApp.Range("A30").Select
        xlApp.ActiveCell.FormulaR1C1 = "PLEASE ARRANGE FOR COLLECTION OF FREIGHT CHARGES"
        xlApp.Range("A31").Select
        xlApp.ActiveCell.FormulaR1C1 = "SEND BILLING TO: JCPENNEY, PO BOX 45111, SALT LAKE CITY, UT 84145"
        xlApp.Range("A33").Select
        xlApp.ActiveCell.FormulaR1C1 = "RETURN MERCHANDISE TO:"
        xlApp.Range("E33").Select
        xlApp.ActiveCell.FormulaR1C1 = "JCPENNEY DISTRIBUTION / RETURN DOCK"
        xlApp.Range("E34").Select
        xlApp.ActiveCell.FormulaR1C1 = "ADDRESS"
        xlApp.Range("A37").Select
        xlApp.ActiveCell.FormulaR1C1 = "RA #:"
        xlApp.Range("D37").Select
        xlApp.ActiveCell.FormulaR1C1 = "TRACKING #:"
        xlApp.Range("G37").Select
        xlApp.ActiveCell.FormulaR1C1 = "DATE ISSUED:"
        xlApp.Range("G3").Select
        xlApp.ActiveCell.FormulaR1C1 = "FROM:"
        xlApp.Cells.Select
        xlApp.Selection.Font.Bold = True
        xlApp.ActiveWindow.Zoom = 80
        With xlApp.Selection.Font
            .Name = "Arial"
            .Size = 12
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
        End With
        xlApp.Cells(1, 1).Select
        With xlApp.Selection.Font
            .Name = "Arial"
            .Size = 16
        End With
        'format columns and rows
        xlApp.Columns("B:B").ColumnWidth = 12
        xlApp.Columns("C:C").ColumnWidth = 13.57
        xlApp.Columns("D:D").ColumnWidth = 17.71
        xlApp.Columns("E:E").ColumnWidth = 12.86
        xlApp.Columns("G:G").ColumnWidth = 18.57
        xlApp.Columns("H:H").ColumnWidth = 15
        xlApp.Range("4:4,6:6,8:8,10:10,12:12,14:14,16:16,18:18,32:32").Select
        xlApp.Selection.RowHeight = 7.5
        'format printing
'        With ActiveSheet.PageSetup
'            .PrintTitleRows = ""
'            .PrintTitleColumns = ""
'        End With
'        ActiveSheet.PageSetup.PrintArea = ""
        With xlApp.ActiveSheet.PageSetup
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = xlApp.InchesToPoints(0.75)
            .RightMargin = xlApp.InchesToPoints(0.75)
            .TopMargin = xlApp.InchesToPoints(1)
            .BottomMargin = xlApp.InchesToPoints(1)
            .HeaderMargin = xlApp.InchesToPoints(0.5)
            .FooterMargin = xlApp.InchesToPoints(0.5)
            .PrintHeadings = False
            .PrintGridlines = False
            .PrintComments = xlPrintNoComments
            .PrintQuality = 600
            .CenterHorizontally = False
            .CenterVertically = False
            .Orientation = xlPortrait
            .Draft = False
            .PaperSize = xlPaperLetter
            .FirstPageNumber = xlAutomatic
            .Order = xlDownThenOver
            .BlackAndWhite = False
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
            .PrintErrors = xlPrintErrorsDisplayed
        End With
        xlApp.ActiveSheet.PageSetup.PrintArea = "$A$1:$J$38"
        'select cell A1
        xlApp.Cells(1, 1).Select
    'place variables on sheet
        'strS
        xlApp.Range("D3").Value = strS
        'strN
        xlApp.Range("D5").Value = strN
        'strF
        xlApp.Range("D7").Value = strF
        'strD
        xlApp.Range("D9").Value = strD
        'dteE
        xlApp.Range("D11").Value = dteE
        'strG,strH,strI,strJ
        xlApp.Range("D13").Value = strG & ", " & strH & ", " & strI & "  " & strJ
        'strV
        xlApp.Range("D15").Value = strV
        'strW
        xlApp.Range("D17").Value = strW
        'strK
        xlApp.Range("D19").Value = strK
        'strP,strQ,strR
        xlApp.Range("D20").Value = strP & ", " & strQ & ", " & strR
        'strX
        xlApp.Range("D23").Value = strX
        'strC,strL
        xlApp.Range("D26").Value = strC & ", " & strL
        'strT
        Select Case True
            Case strT = "JCPCOL"
                xlApp.Range("E34").Value = "555 SCARBOROUGH BLVD, COLUMBUS, OH   43232"
            Case strT = "JCPMAN"
                xlApp.Range("E34").Value = "1339 TOLLAND TURNPIKE, MANCHESTER, CT  06040"
            Case strT = "JCPLEN"
                xlApp.Range("E34").Value = "10500 LACKMAN ROAD, LENEXA, KS  66250"
            Case strT = "JCPREN"
                xlApp.Range("E34").Value = "11111 STEAD BLVD, ANDERSON ACRES, NV  89506"
        End Select
        'strB
        xlApp.Range("B37").Value = strB
        'strD
        xlApp.Range("E37").Value = strD
        'dteA
        xlApp.Range("H37").Value = dteA
        'strY
        xlApp.Range("H3").Value = strY
    'name sheet
        xlApp.Worksheets(intX).Name = Replace(strB, "/", "_") & "_" & intX
    'add to counter
        intX = intX + 1
        rstX.MoveNext
    Loop
    xlApp.Worksheets(1).Select
    
    'Save Excel Application
    Dim strfile As String
    strfile = BrowseForFolder("Please select a folder in which to save the Return Authorizations for " & strHub & "...") & "\" & strHub & "_RA_" & Format(Now(), "yyyymmdd") & ".xls"
    xlApp.ActiveWorkbook.SaveAs strfile

    MsgBox "DONE! The export Excel file has been saved at " & strfile & "."
    xlApp.Visible = True
    'xlApp.Quit
    Set xlApp = Nothing
    Set rstX = Nothing
    Set qdfX = Nothing
    Exit Sub

ERROR_1:
    Set qdfX = Nothing
    Set rstX = Nothing
    MsgBox "ERROR #1", vbCritical, "WARNING!"
    Exit Sub

ERROR_2:
    'xlApp.Quit
    xlApp.ActiveWorkbook.Close False
    xlApp.Quit
    Set xlApp = Nothing
    Set rstX = Nothing
    Set qdfX = Nothing
    MsgBox "ERROR #2", vbCritical, "WARNING!"
End Sub
Private Sub Command32_Click()
On Error GoTo Err_Command32_Click


    DoCmd.Quit

Exit_Command32_Click:
    Exit Sub

Err_Command32_Click:
    MsgBox Err.Description
    Resume Exit_Command32_Click
    
End Sub

I have made the below changes to the code
Code: 
Option Compare Database

' everything from here to "' finish" is for browser button
Option Explicit

Public CDCaption, CDSearchString, CDInitDir As String


[B]    Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
            "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
       
    Private Type OPENFILENAME
        lStructSize As Long
        hwndOwner As LongPtr
        hInstance As LongPtr
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As LongPtr
        lpTemplateName As String
    End Type

Private Type BROWSEINFO
        hOwner As LongPtr
        pidlRoot As LongPtr
        pszDisplayName As String
        lpszTitle As String
        ulFlags As Long
        lpfn As LongPtr
        lParam As LongPtr
        iImage As Long
    End Type
                        
    Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
        (lpBrowseInfo As BROWSEINFO) As LongPtr
        
    Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
        (ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean

            
Private Const BIF_RETURNONLYFSDIRS = &H1
[/B]


[B]Public Function BrowseFolder(szDialogTitle As String) As String
  Dim X As Long, dwIList As LongPtr
  Dim bi As BROWSEINFO
  Dim szPath As String, wPos As Integer
  
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function[/B]

Any advice or points in the right direction is helpful. Thank you in advance.
:confused:
 
MarkK

MarkK

bit cruncher
Local time
Today, 13:47
Joined
Mar 17, 2004
Messages
8,181
What version of Access are you using? I think versions after 2002 (XP) include a FileDialog object, which allow to do this without using a Windows API call.
 
F

FrozenMana

Registered User.
Local time
Today, 16:47
Joined
Aug 10, 2015
Messages
27
I am not sure how many versions of MS Access are using this database. Currently I am trying to update the coding to work with 2013 64-bit. I am not proficient in VBA and have not delt with API Functions until I was asked to help with these. Due to how this is written I haven't been able to follow it through enough to change the coding.
Apologies if that does not make sense. It has been a long few days.
 
MarkK

MarkK

bit cruncher
Local time
Today, 13:47
Joined
Mar 17, 2004
Messages
8,181
My suggestion is that you research the Office.FileDialog object. I believe you can use it within your VBA code to open file and folder browsers without having to resort to using Windows API calls.
Hope this helps,
 
F

FrozenMana

Registered User.
Local time
Today, 16:47
Joined
Aug 10, 2015
Messages
27
I do not use the API calls on any of the databases that I normally work with or create. However doing that for this one would mean re-creating the entire database and since I am not aware of its full purpose it seemed more logical to learn how to update the coding. Also since there are a few other databases that need these updates as well.
 
F

FrozenMana

Registered User.
Local time
Today, 16:47
Joined
Aug 10, 2015
Messages
27
Changed Function LaunchCD with FunctionGetMyFile and changed LaunchCD (ME) under Browser1 (x) to GetMyFile (1) and it worked.
Code: 
Sub Browser1(X)

Dim strPath As String, FilePath As Object

Select Case X
    Case 1: Set FilePath = Me.txtFile
'    Case 2: Set FilePath = txtFile2
'    Case 3: Set FilePath = txtFile3
End Select

    CDSearchString = "*.*"
 
    CDCaption = "Select File to Attach..."
    
    If IsNull(FilePath.Value) Or FilePath.Value = "" Then
        CDInitDir = "C:\"
    Else
        CDInitDir = FilePath.Value
    End If
    
    strPath = GetMyFile(1)
    If strPath <> "None Selected" Then FilePath.Value = strPath
    
End Sub
Public Function GetMyFile(strTitle As String) As String

    Dim OpenFile    As OPENFILENAME
    Dim lReturn     As Long
   
    OpenFile.lpstrFilter = ""
    OpenFile.nFilterIndex = 1
    OpenFile.hwndOwner = 0
    OpenFile.lpstrFile = String(257, 0)
    #If VBA7 Then
        OpenFile.nMaxFile = LenB(OpenFile.lpstrFile) - 1
        OpenFile.lStructSize = LenB(OpenFile)
    #Else
        OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
        OpenFile.lStructSize = Len(OpenFile)
    #End If
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    OpenFile.lpstrInitialDir = "C:\My Documents"
    OpenFile.lpstrTitle = strTitle
    OpenFile.flags = 0
    lReturn = GetOpenFileName(OpenFile)
   
    If lReturn = 0 Then
        GetMyFile = ""
    Else
        GetMyFile = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
    End If
   
End Function
 
Last edited:
S

smig

Registered User.
Local time
Today, 23:47
Joined
Nov 25, 2009
Messages
2,209
I use the win browser API
It require some changes while moving to ac2010 (vba 7)
Look for my post from the last week.
 
You must log in or register to reply here.

Similar threads

AOB
Solved Making an old 32-bit MDB file 64-bit-compilable
Replies
5
Views
1,048
sonic8
S
J
Adjusting to work in VBA 64 bit
Replies
5
Views
950
jet8510
J
M
Solved Get Username in 64 bit
Replies
3
Views
686
MarkK
MarkK
C
Select Case Textbox
Replies
7
Views
251
Pat Hartman
P
oxicottin
Solved Multiselect listbox loop showing there isn't data
Replies
4
Views
258
pbaldy
pbaldy

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom