TransferSpreadsheet/Prompt for File Open dialog 1

[bicit]

Was wondering if anyone had a good code snippet to do this? I would like to allow the user to select their own location to place the file, but don't see a clear example within the VB help..
thx.

 

[Blorf]

Hi. I got this code here at tek-tips also. Works nicely for me. The form update portion at the bottom you will have to modify to your own ends.

ChaZ

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 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 = "Solid Works SpreadSheet" + Chr(0) + "*.Xls;" + _
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 = "Load Images"
.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

Function SelectFiles()
Dim FileList As New Collection
Dim I As Long
Dim S As String

ShowFileOpenDialog FileList
With FileList
If .Count > 0 Then
g = Trim(.Item(1))
Forms!startup.Fle = Left(g, InStr(g, ".XLS") + 3)
Else
MsgBox "No file Was selected!"
End If
End With
End Function

 

[bicit]

Thank you blorf, this worked great with a little massaging!
--Mike

 

[Blorf]

Glad to help.

ChaZ