Community
Inventor Programming - iLogic, Macros, AddIns & Apprentice
Inventor iLogic, Macros, AddIns & Apprentice Forum. Share your knowledge, ask questions, and explore popular Inventor topics related to programming, creating add-ins, macros, working with the API or creating iLogic tools.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Folder Browser Needed for VBA 7 64 bit.

23 REPLIES 23
SOLVED
Reply
Message 1 of 24
Gruff
33336 Views, 23 Replies

Folder Browser Needed for VBA 7 64 bit.

I need a folder browser for VBA 7 64 bit that I can set the initial Folder.

 

What are my options?

 

I cannot figure out how to convert my 32 bit Windows API code to 64 bit.

I have the declare and UDT written properly but not all the rest that does the work.

 

I tried the Window Shell Object, but could not get the initial directory to work.

 

Any Ideas?

23 REPLIES 23
Message 2 of 24
Robert..F
in reply to: Gruff

I have not tried this myself as we're still on 2013, but in theory you should be able to use the PtrSafe keyword like this:

 

Private Declare PtrSafe Function GetFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (popenfilename As OPENFILENAME) As Long

 Here is a routine I've used in the past to use the windows API to browse for a fiel and open it in excel.  I added the PTrSafe keyword.  Please let me know if it works!  Smiley Wink

 

'' Adapted from c++ examples: http://msdn.microsoft.com/en-us/library/windows/desktop/ms646928%28v=vs.85%29.aspx
'' Code to use the windows control to open or save a file using the open file dialog boxes in Microsoft Windows


'' Uncomment one of these two depending if you want to open a file or save a file
''Private Declare PtrSafe Function GetFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (popenfilename As OPENFILENAME) As Long
Private Declare PtrSafe Function GetFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (popenfilename As OPENFILENAME) As Long

Public Const OFN_OVERWRITEPROMPT& = &H2

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


Public Function ShowOpen(Filter As String, InitialDir As String, DialogTitle As String, InitialFileName As String) As String
    Dim OFName As OPENFILENAME
    'Set the structure size
    OFName.lStructSize = Len(OFName)
    'Set the owner window
    OFName.hwndOwner = 0
    'Set the filter
    OFName.lpstrFilter = Filter
    'Set the maximum number of chars
    OFName.nMaxFile = 255
    'Create a buffer and set intial file name
    OFName.lpstrFile = Left(InitialFileName & ".PDF" & String(256, 0), 256)
    'Create a buffer
    OFName.lpstrFileTitle = Space$(254)
    'Set the maximum number of chars
    OFName.nMaxFileTitle = 255
    'Set the initial directory
    OFName.lpstrInitialDir = InitialDir
    'Set the dialog title
    OFName.lpstrTitle = DialogTitle
    'no extra flags
    OFName.flags = 0
    'show overwrite file prompt
    OFName.flags = OFN_OVERWRITEPROMPT
    'Show the 'Open File' dialog
    If GetFileName(OFName) Then
        ShowOpen = Trim(OFName.lpstrFile)
    Else
        ShowOpen = ""
    End If
End Function

'' Trims null charectors from a string
Private Function TrimNull(ByVal strItem As String) As String
    Dim intPos As Integer
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
        TrimNull = Left(strItem, intPos - 1)
        Else
        TrimNull = strItem
    End If
        
End Function


'' Example on how to use

Sub OpenFileExample()
    
    
    '' Open the Save as form through the windows api and allow the designer a chance to
    '' select the save location and filename

    Dim Filter As String
    Filter = "EXCEL FILES (*.XLS)" & Chr$(0) & "*.XLS" & Chr$(0) & _
                "All Files (*.*)" & Chr$(0) & "*.*"
    
    '' Set the directory to begin looking
    Dim InitialDir As String
    InitialDir = CurDir
    
    '' Set the title of the dialog
    Dim DialogTitle As String
    DialogTitle = "Please select a file to open (or to save)"
    
    Dim FileName As String
    FileName = ShowOpen(Filter, InitialDir, DialogTitle, FileName)
    FileName = TrimNull(FileName)
    
    '' Check to make sure user hasn't selected cancel or something else which will cause the
    '' filename to report blank
    If Len(FileName) < 1 Then
        MsgBox ("Something has gone wrong, please try again.")
        Exit Sub
    End If

    '' Open the document in Excel
    Dim oXls As Excel.Application
    Set oXls = CreateObject("Excel.Application")
    oXls.Visible = True
    Dim oWorkBook As Excel.Workbook
    Set oWorkBook = oXls.Workbooks.Open(FileName)
    
    
End Sub

 

Message 3 of 24
Gruff
in reply to: Robert..F

Robert,

 

1) I am talking about the Folder Browser, Not the File Browser.

 

2) Just adding PtrSafe doesn't work.

There are numerous changes to the 64 bit version of VBA 7.

 

Several have to do with new VBA 7 64 bit datatypes or datatype conversions.

 

LongPtr

LongLong

 

My problem is I do not know when to use the new datatypes or conversions..

 

Not just in the declare statements but in any code that has to pass Window API arguments

 

With SHBrowseForFolder()  there is a lot of callback and messing about with addresses.

Message 4 of 24
Robert..F
in reply to: Gruff

Sorry Gruff, I didn't read that correctly, and unfortunately my experience with VBA 7 is extremely limitted.  I've been trying to get prepared because we'll be updating soon.  Wish I could have been more help.

 

Message 5 of 24
Gruff
in reply to: Robert..F

finally!  this works

 

Dang I wish this forum allow me to paste code with indents..

 

Option Explicit

'----------------------------------------------------------------------

' 64 bit VBA 7 version of File and Folder Browswers

' FileBrowseOpen()
' FileBrowseSave()
' FolderBrowse()

' Much of the original 32 bit module was donated by the good people of XtremeVbTalk.com
' I massaged it to be 64 bit with VBA 7 code lifted from numerous sites on the web

'----------------------------------------------------------------------


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

Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias _
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) As Long

Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
(ByVal pidList As LongPtr, ByVal lpBuffer As String) As Long


Public Declare PtrSafe Function SendMessageA Lib "user32" _
(ByVal Hwnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As LongPtr)

Private Const BIF_RETURNONLYFSDIRS As Long = 1
Private Const CSIDL_DRIVES As Long = &H11
Private Const WM_USER As Long = &H400
Private Const MAX_PATH As Long = 260

'// message from browser
Private Const BFFM_INITIALIZED As Long = 1
Private Const BFFM_SELCHANGED As Long = 2
Private Const BFFM_VALIDATEFAILEDA As Long = 3 '// lParam:szPath ret:1(cont),0(EndDialog)
Private Const BFFM_VALIDATEFAILEDW As Long = 4 '// lParam:wzPath ret:1(cont),0(EndDialog)
Private Const BFFM_IUNKNOWN As Long = 5 '// provides IUnknown to client. lParam: IUnknown*

'// messages to browser
Private Const BFFM_SETSTATUSTEXTA As Long = WM_USER + 100
Private Const BFFM_ENABLEOK As Long = WM_USER + 101
Private Const BFFM_SETSELECTIONA As Long = WM_USER + 102
Private Const BFFM_SETSELECTIONW As Long = WM_USER + 103
Private Const BFFM_SETSTATUSTEXTW As Long = WM_USER + 104
Private Const BFFM_SETOKTEXT As Long = WM_USER + 105 '// Unicode only
Private Const BFFM_SETEXPANDED As Long = WM_USER + 106 '// Unicode only


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

Public Type BrowseInfo
hWndOwner As LongPtr
pIDLRoot As LongPtr
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfnCallback As LongPtr
lParam As LongPtr
iImage As Long
End Type

 

'====== File Browsers for 64 bit VBA 7 ========

Public Function FileBrowseOpen(ByVal sInitFolder As String, _
ByVal sTitle As String, _
ByVal sFilter As String, _
ByVal nFilterIndex As Integer) As String


Dim OpenFile As OPENFILENAME
Dim lReturn As Long

sInitFolder = CorrectPath(sInitFolder)


OpenFile.lpstrInitialDir = sInitFolder

' Swap filter separator for api separator
sFilter = Replace(sFilter, "|", Chr(0))



OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = nFilterIndex
OpenFile.lpstrTitle = sTitle


OpenFile.hWndOwner = 0
OpenFile.lpstrFile = String(257, 0)

OpenFile.nMaxFile = LenB(OpenFile.lpstrFile) - 1
OpenFile.lStructSize = LenB(OpenFile)

OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile

OpenFile.flags = 0

lReturn = GetOpenFileName(OpenFile)

If lReturn = 0 Then
FileBrowseOpen = ""
Else
FileBrowseOpen = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
End If

End Function

Public Function FileBrowseSave(ByVal sDefaultFilename As String, _
ByVal sInitFolder As String, _
ByVal sTitle As String, _
ByVal sFilter As String, _
ByVal nFilterIndex As Integer) As String

Dim PadCount As Integer
Dim OpenFile As OPENFILENAME
Dim lReturn As Long

sInitFolder = CorrectPath(sInitFolder)

' Swap filter separator for api separator
sFilter = Replace(sFilter, "|", Chr(0))

OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1
OpenFile.hWndOwner = 0

PadCount = 260 - Len(sDefaultFilename)
OpenFile.lpstrFile = sDefaultFilename & String(PadCount, Chr(0))
'OpenFile.lpstrFile = String(257, 0)

OpenFile.nMaxFile = LenB(OpenFile.lpstrFile) - 1
OpenFile.lStructSize = LenB(OpenFile)

OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = sInitFolder
OpenFile.lpstrTitle = sTitle
OpenFile.flags = 0
lReturn = GetSaveFileName(OpenFile)

If lReturn = 0 Then
FileBrowseSave = ""
Else
FileBrowseSave = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
End If

End Function

 


'====== Folder Browser for 64 bit VBA 7 ========

Public Function FolderBrowse(ByVal sDialogTitle As String, ByVal sInitFolder As String) As String
Dim ReturnPath As String

Dim b(MAX_PATH) As Byte
Dim pItem As Long
Dim sFullPath As String
Dim bi As BrowseInfo
Dim ppidl As Long

sInitFolder = CorrectPath(sInitFolder)

' Note VBA windows and dialogs do not have an hWnd property.
bi.hWndOwner = 0 'Windows Main Screen handle.

' SHGetSpecialFolderLocation bi.hWndOwner, CSIDL_DRIVES, ppidl

bi.pIDLRoot = 0 'ppidl


bi.pszDisplayName = VarPtr(b(0))
bi.lpszTitle = sDialogTitle
bi.ulFlags = BIF_RETURNONLYFSDIRS
If FolderExists(sInitFolder) Then bi.lpfnCallback = PtrToFunction(AddressOf BFFCallback)
bi.lParam = StrPtr(sInitFolder)

pItem = SHBrowseForFolder(bi)

If pItem Then ' Succeeded
sFullPath = Space$(MAX_PATH)
If SHGetPathFromIDList(pItem, sFullPath) Then
ReturnPath = Left$(sFullPath, InStr(sFullPath, vbNullChar) - 1) ' Strip nulls
CoTaskMemFree pItem
End If
End If

If ReturnPath <> "" Then
If Right$(ReturnPath, 1) <> "\" Then
ReturnPath = ReturnPath & "\"
End If
End If

FolderBrowse = ReturnPath

End Function

' typedef int (CALLBACK* BFFCALLBACK)(HWND hwnd, UINT uMsg, LPARAM lParam, LPARAM lpData);
Private Function BFFCallback(ByVal Hwnd As LongPtr, ByVal uMsg As LongPtr, ByVal lParam As LongPtr, ByVal sData As String) As LongPtr
If uMsg = BFFM_INITIALIZED Then
SendMessageA Hwnd, BFFM_SETSELECTIONA, True, ByVal sData
End If
End Function

Private Function PtrToFunction(ByVal lFcnPtr As LongPtr) As LongPtr
PtrToFunction = lFcnPtr
End Function

Private Function CorrectPath(ByVal sPath As String) As String
If Right$(sPath, 1) = "\" Then
If Len(sPath) > 3 Then sPath = Left$(sPath, Len(sPath) - 1) ' Strip backslash from non-root
Else
If Len(sPath) = 2 Then sPath = sPath & "\" ' Append backslash to root
End If
CorrectPath = sPath
End Function


Public Function FolderExists(ByVal sFolderName As String) As Boolean
Dim att As Long
On Error Resume Next
att = GetAttr(sFolderName)
If Err.Number = 0 Then
FolderExists = True
Else
Err.Clear
FolderExists = False
End If
On Error GoTo 0
End Function

Message 6 of 24
Robert..F
in reply to: Gruff

Thanks awesome.  Thanks for sharing the final result.

Message 7 of 24
Gruff
in reply to: Robert..F

Found the Flag values for the Folder Browser.

The following shows which flags to use for enabling a "Make Directory" button.

 

' == Folder Browser flags ==
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_STATUSTEXT As Long = &H4
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_EDITBOX As Long = &H10
Private Const BIF_VALIDATE As Long = &H20
Private Const BIF_NEWDIALOGSTYLE As Long = &H40
Private Const BIF_BROWSEINCLUDEURLS As Long = &H80
Private Const BIF_USENEWUI As Long = (BIF_EDITBOX Or BIF_NEWDIALOGSTYLE)
Private Const BIF_UAHINT As Long = &H100
Private Const BIF_NONEWFOLDERBUTTON As Long = &H200
Private Const BIF_NOTRANSLATETARGETS As Long = &H400
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const BIF_SHAREABLE As Long = &H8000
Private Const BIF_BROWSEFILEJUNCTIONS As Long = &H10000

'...

'...

'...

bi.ulFlags = BIF_RETURNONLYFSDIRS Or BIF_USENEWUI  '<-- Show Make Directory button.

Message 8 of 24
yosso22
in reply to: Gruff

Gruff,


Long shot, but it never hurts to ask.


I've "repurposed" your VBA code for an Excel VBA program. Seems to be working...but I'm getting an error when compiling, and there seem to be some memory leaks with the spreadsheet.

 

Error-----

Compile error:

 

Invalid use of AddressOf operator

Error-----

 

Line in bold is where the compile message originates.

 

Code:

 

 
'====== Folder Browser for 64 bit VBA 7 ========
Public Function FolderBrowse(ByVal sDialogTitle As String, ByVal sInitFolder As String) As String
Dim ReturnPath As String

Dim b(MAX_PATH) As Byte
Dim pItem As Long
Dim sFullPath As String
Dim bi As BrowseInfo
Dim ppidl As Long

sInitFolder = CorrectPath(sInitFolder)

' Note VBA windows and dialogs do not have an hWnd property.
bi.hWndOwner = 0 'Windows Main Screen handle.

' SHGetSpecialFolderLocation bi.hWndOwner, CSIDL_DRIVES, ppidl

bi.pIDLRoot = 0 'ppidl

bi.pszDisplayName = VarPtr(b(0))
bi.lpszTitle = sDialogTitle
bi.ulFlags = BIF_RETURNONLYFSDIRS
If FolderExists(sInitFolder) Then bi.lpfnCallback = PtrToFunction(AddressOf BFFCallback)
bi.lParam = StrPtr(sInitFolder)
pItem = SHBrowseForFolder(bi)

If pItem Then ' Succeeded
sFullPath = Space$(MAX_PATH)
If SHGetPathFromIDList(pItem, sFullPath) Then
ReturnPath = Left$(sFullPath, InStr(sFullPath, vbNullChar) - 1) ' Strip nulls
CoTaskMemFree pItem
End If
End If

If ReturnPath <> "" Then
If Right$(ReturnPath, 1) <> "\" Then
ReturnPath = ReturnPath & "\"
End If
End If

FolderBrowse = ReturnPath

End Function

 

 

Give Kudos to further enhance the value of these forums. Thank you! Smiley Happy
Tags (2)
Message 9 of 24
Gruff
in reply to: Gruff

What verson of Excel are you using?

 

I was under the impression that the Excel API had File and Folder Browsing tools built in.

 

Are you sure you have 64 bit Excel installed?  Office 2010-2012 defaults to 32 bit on install regardless of the processer.

You have to manually run the 64 bit install from a sub folder on the install disk.

 

If your running 32 bit VBA then my posted code will fail.

Message 10 of 24
yosso22
in reply to: Gruff

Gruff,

 

I appreciate your reply.

 

Currently using Excel 2010 (32 bit, now, but it was 64 bit when I started the Excel Program).  Excel probably does have the built-in browsing, but I'm learning as I go...so I of course took the most difficult path. Smiley Happy

 

I'm actually saving an Autocad Drawing that I create with Excel VBA (writing Excel data to a custom table in a new drawing).

 

 

M.

 

 

 

Give Kudos to further enhance the value of these forums. Thank you! Smiley Happy
Message 11 of 24
yosso22
in reply to: yosso22

Finally ended up using the built-in file browser in AutoCAD - works great and it's less code! 

 

Thank you again for pointing me in the right direction.

 

Mike

Give Kudos to further enhance the value of these forums. Thank you! Smiley Happy
Message 12 of 24
rbsolanki71
in reply to: yosso22

Can you provide me your code for using built-in file broweser in AutoCAD ?

Message 13 of 24
yosso22
in reply to: rbsolanki71

The below VBA code is from Excel, and is simply saving the AutoCAD file using the Excel built-in file browswer, most of the code is error checking to make sure the path and file name are valid, the usual issues.

 

I'm using a Function to open and save...most likely kludgey, but it works.

 

Function GetFileName(FilePath As String, FileTitle As String, OpenFile As Boolean) As Variant

' Save newly created AutoCAD file

Dim strFileFilter As String
Dim strFileName As String
Dim Title As String
Dim tempFileName As Variant

Title = FileTitle
strFileFilter = "DWG (AutoCAD drawing) (*.dwg),*.dwg"

' Make sure the default path is the workbook path
ChDrive ThisWorkbook.path
ChDir ThisWorkbook.path

If OpenFile Then
    tempFileName = Application.GetOpenFileName(strFileFilter, , "Select File to Open", , False)
Else
    tempFileName = Application.GetSaveAsFilename("SAVE FILE", strFileFilter, , Title)
End If

GetFileName = tempFileName ' If tempFileName = FALSE then exit parent sub...

End Function

 

 

Give Kudos to further enhance the value of these forums. Thank you! Smiley Happy
Message 14 of 24
rbsolanki71
in reply to: yosso22

The code workd in excel but not in AutoCAD VBA.

Any reason? modification needed to make it working in AutoCAD VBA. I am using AutoCAD 2014.

Thanks,

Message 15 of 24
yosso22
in reply to: rbsolanki71

As this is an Inventor forum, we are straying a bit off topic. 🙂

 

That being said, I've never actually tried to use the Open file dialog in AutoCAD using VBA.  Seems like I've always pushing information from Excel into an AutoCAD drawing.  

 

The link below has a pretty good explanation on how to get a File Dialog system working with AutoCAD and VBA, a bit dated, and you might have some problems with 64bit AutoCAD.

 

https://forums.autodesk.com/t5/Visual-Basic-Customization/VBA-Open-File-with-Dialog-Box/td-p/1726554

 

and 

 

http://vbnet.mvps.org/code/comdlg/fileopendlg.htm

 

To update the method above, check out the theswamp.org.  The forums on theswamp.org  are an excellent resource for AutoCAD programming and somebody recently posted and updated module to be used with 64 bit VBA.

 

http://www.theswamp.org/index.php?topic=47580.0

 

Finally, here's an alternative approach using VBA and LISP...and it seems like the simplest approach.

 

http://adndevblog.typepad.com/autocad/2013/03/selecting-file-with-standard-autocad-fileopen-dialog.h...

 

Good luck!

 

M.

 

 

 

 

 

 

 

Give Kudos to further enhance the value of these forums. Thank you! Smiley Happy
Message 16 of 24
aksaks
in reply to: Gruff

Thank you very much. How does one get the file browser portion to return a multiple file section?

Message 17 of 24
yosso22
in reply to: aksaks

I've not yet tried out the code linked below...but they do discuss multiple file selections.

 

http://forums.autodesk.com/t5/visual-basic-customization/vba-7-1-commondialog-lost/td-p/3841702

 

I'm going to try and get the code above working in an example DVB.

 

M.

Give Kudos to further enhance the value of these forums. Thank you! Smiley Happy
Message 18 of 24
sjain0909
in reply to: yosso22

Hello,Could you please help me , in this code i am trying to open a save dialog box to save a file, but i am not able to open.

i tried it on OFFICE 10 (64 bit).

 

Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
' Opens the file save dialog.

Dim of As OPENFILENAME
Dim intRet As Integer
Dim strPath As String

'Const OFN_ALLOWMULTISELECT = &H200
'Const OFN_CREATEPROMPT = &H2000
'Const OFN_EXPLORER = &H80000
'Const OFN_FILEMUSTEXIST = &H1000
'Const OFN_HIDEREADONLY = &H4
'Const OFN_NOCHANGEDIR = &H8
'Const OFN_NODEREFERENCELINKS = &H100000
'Const OFN_NONETWORKBUTTON = &H20000
'Const OFN_NOREADONLYRETURN = &H8000
'Const OFN_NOVALIDATE = &H100
'Const OFN_OVERWRITEPROMPT = &H2
'Const OFN_PATHMUSTEXIST = &H800
'Const OFN_READONLY = &H1
'Const OFN_SHOWHELP = &H10

MSAOF_to_OF msaof, of
of.Flags = 0 '2 ^ 3 Or 2 ^ 9
of.Flags = of.Flags Or OFN_HIDEREADONLY
intRet = GetSaveFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
strPath = _
Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
End If
MSA_GetSaveFileName = intRet
End Function

Message 19 of 24
Gruff
in reply to: sjain0909

Sorry, I am not sure what I am seeing regarding the code you posted.
I am not well versed in the topic.
--
Tom Groff
Software Engineering / IT
Pacific Stainless Products Inc.

Direct: 503-366-8274
Ext: 274
Message 20 of 24
shaideru
in reply to: Gruff

Hey Gruff, How can I translate this function to VB7.1 64bit 

 

Private Function getRawFname(frm As Object, ByVal gsi As Boolean) As String
   If gsi Then
      frm.cmdFD.Filter = "Raw Data (*.raw)|*.raw"
   Else
      frm.cmdFD.Filter = "Comma Delimited (*.cdd)|*.cdd"
   End If
   frm.cmdFD.FilterIndex = 1
   frm.cmdFD.ShowOpen
   getRawFname = frm.cmdFD.FileName
End Function

 

 

Been struggling for weeks now. cmdFD is a common dialog box.

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report