Get Multiple File Names

I am looking for a way to browse for multiple drawings and populate a list box with all the file paths in VBA

Thanks in advance

-KarL-

What do you have so far? Thats actually a little bit difficult, as VBA doesn't have the filedialog box built in. It is very doable though

Right now I use a function that references the Excel file open dialog. It works most of the time but lately it is causing problems since we are upgrading some compters to office 2007 so I would like to get rid of the excel reference if possible.

   Set ExcelApp = GetObject(, "Excel.Application")
   If Err <> 0 Then
       Err.Clear
       Set ExcelApp = CreateObject("Excel.Application")
       If Err <> o Then
           MsgBox "Could not start Excel!", vbExclamation
           End
       End If
   End If
   ExcelApp.Visible = True
   Set wbkobj = ExcelApp.Workbooks.Add
   Set shtObj = wbkobj.Worksheets(1)
   BrowseDialogMulti = excel.Application.GetOpenFilename(FileFilter:=(FileType & " (*" & Extension & "),*" & Extension & ", All Files (*.*),*.*"), Title:=Title, MultiSelect:=True)
   ExcelApp.Quit

I haven't played with office 07 yet, so Im not sure how its going to work. Obviously, they (Microsoft) have changed the way you access that box

I often connect to this windows browse box because it is small and easy to prompt the user for one file like a block.

Dim objDialog As Variant, intResult As Variant, 
Dim strFilePath As String
  
Set objDialog = CreateObject("UserAccounts.CommonDialog")
    
'Use The Common Dialog, show open method to get the profile
objDialog.Filter = "Select block (*.DWG)|*.dwg"
objDialog.FilterIndex = 1
objDialog.InitialDir = "C:\"
intResult = objDialog.ShowOpen

If intResult = 0 Then
 Exit Sub
Else
'Get the full path and filename
 strFilePath = objDialog.FileName
End If

Msgbox  strFilePath
End Sub

However, it does not support multi file selctions that I am aware of.

There is Common Open File Dialog box code out there that a lot of other CAD guys use; because of the large amount of code it uses, I only use it in the case that I need advanced features like multi select etc.

Here is an example of that code

Good luck

ML

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenFileName As OPENFILENAME) As Long
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

Sub Test()
Dim Filter As String
Dim InitialDir As String
Dim DialogTitle As String
Dim OutputStr As String
Filter = "Drawing Files (*.dwg)" + Chr$(0) + "*.dwg" + Chr$(0) + _
"All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
InitialDir = "C:\Documents and Settings\%username%\Desktop"
DialogTitle = "Open a DWG file"
OutputStr = ShowOpen(Filter, InitialDir, DialogTitle)
MsgBox OutputStr
End Sub

Public Function ShowOpen(Filter As String, _
InitialDir As String, DialogTitle 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
OFName.lpstrFile = Space(254)
'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 the 'Open File' dialog
If GetOpenFileName(OFName) Then
ShowOpen = Trim(OFName.lpstrFile)
Else
ShowOpen = ""
End If
End Function

Cmd

In Office 2007, it is now called The Ribbon.

While it take some time to get use to, there are a lot of new and advanced features that I really like.

If you are a big Excel junky like me, then this will be a real help.

It is very good for referencing 2003 to see what you need in 2007

http://office.microsoft.com/assistance/asstvid.aspx?assetid=XT101493291033&vwidth=1044&vheight=788&type=flash&CTT=11&Origin=HA101491511033

ML

There is Common Open File Dialog box code out there that a lot of other CAD guys use; because of the large amount of code it uses, I only use it in the case that I need advanced features like multi select etc.

I got the code to work but it is still only allowing me to select one drawing. What do I need to change to get multiple drawings?

I got the code to work but it is still only allowing me to select one drawing. What do I need to change to get multiple drawings?

I dont have my souce with me (Im at work), but essentially you have to change the FLAGS variable in the OPENFILENAME UDT. Its a bit of AND'ing of the bits and, like a lot of things API, not many people memorize it, only plagarize it.

Also, once you start returning multiple filenames, you have to parse out the indiviual filenames from what comes back as a multiple-null string, and pack that back into a variant. The first part of the returned string will be the PATH only, then an ascii zero, then followed by each individual filename ONLY, without the path, each followed by another ascii zero. The SPLIT function works well here; but you have to remember to add the PATH back in front of each filename.

Confusing? Possibly. While it can be fun to learn, a copy-and-paste module is oh-so-convenient....

well, I found some source online and patched it quick, I apologize to whomever I plagarized from; but anyhoo, here it is.

The code will open many types of files, and many files at once; you may see that the file open allows selecting both .DWG and .DXF in the same dialog window.

Yes, i see a discrepancy with the code returning filenames with a double backslash "\\" if multiple files are opened from the root drive;

but Im on lunch, dont have time to fix it, and it works anyway, even with the double backslashes. So sue me ...

' --------- snip ----- snip -------------

Public 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 Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _

"GetOpenFileNameA" (pOpenFileName As OPENFILENAME) As Long

Public Const OFN_ALLOWMULTISELECT = &H200&

Public Const OFN_EXPLORER = &H80000

Public Const OFN_FILEMUSTEXIST = &H1000&

Public Const OFN_HIDEREADONLY = &H4&

Public Const OFN_PATHMUSTEXIST = &H800&

Sub SelectManyFiles()

Dim FileList As New Collection

Dim I As Long

Dim S As String

ShowFileOpenDialog FileList

With FileList

If .Count > 0 Then

S = "The following files were selected:" + vbCrLf

For I = 1 To .Count

S = S + .Item(I) + vbCrLf

Next

MsgBox S

Else

MsgBox "No files were selected!"

End If

End With

End Sub

Sub ShowFileOpenDialog(ByRef FileList As Collection)

Dim OpenFile As OPENFILENAME

Dim lReturn As Long

Dim FileDir As String

Dim FilePos As Long

Dim PrevFilePos As Long

With OpenFile

.lStructSize = Len(OpenFile)

.hwndOwner = 0

.hInstance = 0

.lpstrFilter = "AutoCad Drawings" + Chr(0) + "*.dwg;*.dxf;" + _

Chr(0) + "All Files (*.*)" + Chr(0) + "*.*" + Chr(0) + Chr(0)

.nFilterIndex = 1

.lpstrFile = String(4096, 0)

.nMaxFile = Len(.lpstrFile) - 1

.lpstrFileTitle = .lpstrFile

.nMaxFileTitle = .nMaxFile

.lpstrInitialDir = "C:\"

.lpstrTitle = "Multi Select Drawings"

.flags = OFN_HIDEREADONLY + _

OFN_PATHMUSTEXIST + _

OFN_FILEMUSTEXIST + _

OFN_ALLOWMULTISELECT + _

OFN_EXPLORER

lReturn = GetOpenFileName(OpenFile)

If lReturn 0 Then

FilePos = InStr(1, .lpstrFile, Chr(0))

If Mid(.lpstrFile, FilePos + 1, 1) = Chr(0) Then

FileList.Add .lpstrFile

Else

FileDir = Mid(.lpstrFile, 1, FilePos - 1)

Do While True

PrevFilePos = FilePos

FilePos = InStr(PrevFilePos + 1, .lpstrFile, Chr(0))

If FilePos - PrevFilePos > 1 Then

FileList.Add FileDir + "\" + _

Mid(.lpstrFile, PrevFilePos + 1, _

FilePos - PrevFilePos - 1)

Else

Exit Do

End If

Loop

End If

End If

End With

End Sub

' --------- snip ----- snip -------------

Sweet, thats what I needed!

Thanks everyone for the help.

-KarL-

Hi Karl

Unfortunately I can not give you that answer because I do not know.

I was given that code but never really needed t use it; I use the first one that I posted all of the time because I really ever only need to select one file at a time.

Try playing around with code and see what you get.

The other alternative is to just simply do a Google Search on ACAD and Open File Dialog; I assure you that you will get tons of hits.

If I get some time, may be I can look at it but the after is likely a click away.

Hmm, if you notice, there is a constant set for mutliselect, you will just need to know where to put it.

ML

How do you get the above code to work in the last post.

When I cut/paste it in a form the following lines are in red.

Public Const OFN_ALLOWMULTISELECT = &H200&

Public Const OFN_EXPLORER = &H80000

Public Const OFN_FILEMUSTEXIST = &H1000&

Public Const OFN_HIDEREADONLY = &H4&

Public Const OFN_PATHMUSTEXIST = &H800&

Is there something I am missing?

Thank you,

Does it have to be in vba? I did something like this for a fas compiler. This is before I figured out a better way to secure my lisps.

edit____

I removed my fas compiler lisp so you can run with this if you choose to go this route

m-file.LSP

Program name.dcl

How do you get the above code to work in the last post.

When I cut/paste it in a form the following lines are in red.

Public Const OFN_ALLOWMULTISELECT = &H200&

Public Const OFN_EXPLORER = &H80000

Public Const OFN_FILEMUSTEXIST = &H1000&

Public Const OFN_HIDEREADONLY = &H4&

Public Const OFN_PATHMUSTEXIST = &H800&

 

Is there something I am missing?

Thank you,

Wow. I posted that code many moons ago. The lines are coming back as RED, because "Public CONST" declares are not allowed in a Form Module. The Code posted there was to be dropped entirely into its own ".BAS" module, and then called FROM your Form Module.

You put related code into its own module, and then 'drag and drop' it into your

application whenever you need that functionality. That makes the code MODULAR.

Below is a newer version of that code. It has not only "File Open" dialog capabilities, but also "File Save" and "Browse for Folder" dialogs, as well. It also allows you to set your initial opening folder to a network drive - something VB alone doesnt let you do. The File Open routine accepts selection of One, or many, files. It returns a variant - EMPTY if no files selected, or an array of fully qualified pathspecs to each file selected.

Also, the first subroutine there, "Main", is basically a demo sub showing off the features. It is sample code. Try running it. You should be able to copy and paste code from that subroutine, into your FORM code, and it will run.

One Caveat - normally, "Open", Save", etc dialogs are MODAL from the App that calls them. They pop up, and you cant do anything until you are finished with the File Open Dialog. This code DOES NOT do that - if you click on another form, the File Open dialog will be drawn behind the other window. In order to make the dialogs MODAL, you have to get the memory address of your calling Application. I could hardwire in the Acad Window, but then this code wouldnt work in, say, Excel, or VB, or SolidWorks. So I cheated, and got the address of the Windows Desktop instead - but now the code should work anywhere.

CommonDialog.txt

Hi,

Firstly, thank rocheey to show his code. However it still has some errors. I have tried to fix it and it works perfectly for me.

Here is the code, hope it help you so much.

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenFileName As OPENFILENAME) As Long
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 Const OFN_ALLOWMULTISELECT = &H200&
Private Const OFN_EXPLORER = &H80000
Private Const OFN_FILEMUSTEXIST = &H1000&
Private Const OFN_HIDEREADONLY = &H4&
Private Const OFN_PATHMUSTEXIST = &H800&

Sub SelectManyFiles()
Dim FileList As New Collection
Dim I As Long
Dim S As String
ShowFileOpenDialog FileList
With FileList
If .Count > 0 Then
S = "The following files were selected:" + vbCrLf
For I = 1 To .Count
S = S + .Item(I) + vbCrLf
Next
MsgBox S
Else
MsgBox "No files were selected!"
End If
End With
End Sub

Sub ShowFileOpenDialog(ByRef FileList As Collection)
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim FileDir As String
Dim FilePos As Long
Dim PrevFilePos As Long
With OpenFile
.lStructSize = Len(OpenFile)
.hwndOwner = 0
.hInstance = 0
.lpstrFilter = "AutoCad Drawings" + Chr(0) + "*.dwg;*.dxf;" + _
Chr(0) + "All Files (*.*)" + Chr(0) + "*.*" + Chr(0) + Chr(0)
.nFilterIndex = 1
.lpstrFile = String(4096, 0)
.nMaxFile = Len(.lpstrFile) - 1
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = .nMaxFile
.lpstrInitialDir = "C:\"
.lpstrTitle = "Multi Select Drawings"
.flags = OFN_HIDEREADONLY + _
OFN_PATHMUSTEXIST + _
OFN_FILEMUSTEXIST + _
OFN_ALLOWMULTISELECT + _
OFN_EXPLORER
lReturn = GetOpenFileName(OpenFile)
If lReturn <> 0 Then
FilePos = InStr(1, .lpstrFile, Chr(0))
If Mid(.lpstrFile, FilePos + 1, 1) = Chr(0) Then
FileList.Add .lpstrFile
Else
FileDir = Mid(.lpstrFile, 1, FilePos - 1)
Do While True
PrevFilePos = FilePos
FilePos = InStr(PrevFilePos + 1, .lpstrFile, Chr(0))
If FilePos - PrevFilePos > 1 Then
FileList.Add FileDir + "\" + _
Mid(.lpstrFile, PrevFilePos + 1, _
FilePos - PrevFilePos - 1)
Else
Exit Do
End If
Loop
End If
End If
End With
End Sub

Hi tuntnguyen,

I copied your code, and it works perfectly

However,...

I need to open the drawings one by one (a LISP routine will edit each drawing, using acaddoc)

In which variable can I find the drawings, and how do I open them accordingly?

Before I used a fixed directory to place the drawings which had to be edited

VBA created a list of all the drawings in this directory in the variable "Drawing"

Below you find my "opening" code:

Do While Len(Drawing) > 0
          Tekopen = Input_Dir & "\" & Drawing
          AutoCAD.Documents.Open (Tekopen)
          AutoCAD.ActiveDocument.Close
          Drawing = Dir()
Loop

Anyone can support me in this one?

Regards,

Frans

Hi all,

Can someone help me with the above problem?

Thanks,

Frans