keep track of where you started, change drives and folders, do the
..getopenfilename, and change back to what you saved.
Dim CurFolder as string
dim NewFolder as string
dim str as variant 'could be a boolean false!
curfolder = curdir
newfolder = "C:\my test folder"
chdrive newfolder
chdir newfolder
str = application.getopenfilename
'change back
chdrive curfolder
chdir curfolder
if str = false then
'user hit cancel
exit sub '????
end if
msgbox str
========================
If you're using UNC paths (\\server\sharename\folder...), then this won't work.
But there are API functions that will work--in fact, these API's will will in
UNC paths or mapped drives.
Saved from a previous post:
Option Explicit
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
Sub Loader1()
Dim myFileName As Variant
Dim myCurFolder As String
Dim myNewFolder As String
myCurFolder = CurDir
myNewFolder = "\\share\folder1\folder2"
On Error Resume Next
ChDirNet myNewFolder
If Err.Number <> 0 Then
'what should happen
MsgBox "Please change to your own folder"
Err.Clear
End If
On Error GoTo 0
myFileName = Application.GetOpenFilename(filefilter:="CSV Files, *.CSV", _
Title:="Pick a File")
ChDirNet myCurFolder
If myFileName = False Then
MsgBox "Ok, try later" 'user hit cancel
Exit Sub
End If
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & myFileName, Destination:=activesheet.Range("A1"))
.Name = "CreditData-021809dater"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveSheet.Range("A1:AO1").Font.Bold = True
End Sub
Maybe you can pick out the pieces you need.
