InputBox to enter file

**excelvba** · 07-17-2008, 07:48 AM

Hello,
I am trying to program a macro that I can enter a file name in an input box and have that file be imported into a specific spreadsheet. This is the code I have so far. This macro was created using the macro tool in excel. I tried to add the Sub GetInput() but when I take away the ' marks I get an expected end sub error.

'Sub GetInput()
       ' Dim MyInputDir As String       'This line of code is optional
       ' Dim MyInputFile As String
       ' MyInputDir = InputBox("Enter the Directory Name")
       ' MyInputFile = MyInputDir & "_spurscan.csv"
       'End Sub

Sub ImportSensitivityData()
'
' ImportSensitivityData Macro
' Macro recorded 7/16/2008 by tom.donahue
'

'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\PBK1350ReceiverData\SN052375\SN052375_sensitivity.csv", Destination _
        :=Cells)
        .Name = "SN052375_sensitivity_1"
        .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 = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

**davesexcel** · 07-17-2008, 07:59 AM

Hi,
Doesn't the folder require a backslash?
Please wrap your code,

**mudraker** · 07-17-2008, 08:08 AM

Your code looks ok to me

Sub GetInput()
   Dim MyInputDir As String       'This line of code is optional
   Dim MyInputFile As String
   MyInputDir = InputBox("Enter the Directory Name")
   MyInputFile = MyInputDir & "_spurscan.csv"
End Sub

Using an Input box can lead to errors due to mis-typing, spelling mistakes etv

This code will allow the user to select an actual folder

Private Type BrowseInfo ' used by the function GetFolderName
    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

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


Sub TestGetFolderName()
Dim FolderName As String
    FolderName = GetFolderName("Select a folder")
    If FolderName = "" Then
        MsgBox "You didn't select a folder."
    Else
        MsgBox "You selected this folder: " & FolderName
    End If
End Sub

Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BrowseInfo, Path As String, r As Long
Dim X As Long, pos As Integer
    bInfo.pidlRoot = 0& ' Root folder = Desktop
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
        ' the dialog title
    Else
        bInfo.lpszTitle = Msg ' the dialog title
    End If
    bInfo.ulFlags = &H1 ' Type of directory to return
    X = SHBrowseForFolder(bInfo) ' display the dialog
    ' Parse the result
    Path = Space$(512)
    r = SHGetPathFromIDList(ByVal X, ByVal Path)
    If r Then
        pos = InStr(Path, Chr(0))
        GetFolderName = Left(Path, pos - 1)
    Else
        GetFolderName = ""
    End If
End Function

**excelvba** · 07-17-2008, 08:31 AM

Originally Posted by mudraker

Your code looks ok to me

[CODE]
Private Type BrowseInfo ' used by the function GetFolderName
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

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

Function GetFolderName(Msg As String) As String

' returns the name of the folder selected by the user

Dim bInfo As BrowseInfo, Path As String, r As Long
Dim X As Long, pos As Integer
bInfo.pidlRoot = 0& ' Root folder = Desktop
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
' the dialog title
Else
bInfo.lpszTitle = Msg ' the dialog title
End If
bInfo.ulFlags = &H1 ' Type of directory to return
X = SHBrowseForFolder(bInfo) ' display the dialog
' Parse the result
Path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal Path)
If r Then
pos = InStr(Path, Chr(0))
GetFolderName = Left(Path, pos - 1)
Else
GetFolderName = ""
End If

End Function

Sub TestGetFolderName()
Dim FolderName As String
FolderName = GetFolderName("Select a folder")
If FolderName = "" Then
MsgBox "You didn't select a folder."
Else
MsgBox "You selected this folder: " & FolderName
End If
End Sub

Sub ImportSensitivityData()

'With ActiveSheet.QueryTables.Add(Connection:= _
'"TEXT;C:\PBK1350ReceiverData\SN052375\SN052375_sensitivity.csv", Destination _
':=Cells)
'.Name = "SN052375_sensitivity_1"

With ActiveSheet.QueryTables

.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 = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

Using an Input box can lead to errors due to mis-typing, spelling mistakes etv

This code will allow the user to select an actual folder

Private Type BrowseInfo ' used by the function GetFolderName
    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

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


Sub TestGetFolderName()
Dim FolderName As String
    FolderName = GetFolderName("Select a folder")
    If FolderName = "" Then
        MsgBox "You didn't select a folder."
    Else
        MsgBox "You selected this folder: " & FolderName
    End If
End Sub

Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BrowseInfo, Path As String, r As Long
Dim X As Long, pos As Integer
    bInfo.pidlRoot = 0& ' Root folder = Desktop
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
        ' the dialog title
    Else
        bInfo.lpszTitle = Msg ' the dialog title
    End If
    bInfo.ulFlags = &H1 ' Type of directory to return
    X = SHBrowseForFolder(bInfo) ' display the dialog
    ' Parse the result
    Path = Space$(512)
    r = SHGetPathFromIDList(ByVal X, ByVal Path)
    If r Then
        pos = InStr(Path, Chr(0))
        GetFolderName = Left(Path, pos - 1)
    Else
        GetFolderName = ""
    End If
End Function

**excelvba** · 07-17-2008, 09:34 AM

Originally Posted by excelvba

Got rid of the error by changing the sequence of some of the code. I can only get to the folder level. I need to get the File level and the importing function does not work. Any help would beappreciated.


Private Type BrowseInfo ' used by the function GetFolderName
    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


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
        
Function GetFolderName(Msg As String) As String


        
        
' returns the name of the folder selected by the user



Dim bInfo As BrowseInfo, Path As String, r As Long
Dim X As Long, pos As Integer
    bInfo.pidlRoot = 0& ' Root folder = Desktop
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
        ' the dialog title
    Else
        bInfo.lpszTitle = Msg ' the dialog title
    End If
    bInfo.ulFlags = &H1 ' Type of directory to return
    X = SHBrowseForFolder(bInfo) ' display the dialog
    ' Parse the result
    Path = Space$(512)
    r = SHGetPathFromIDList(ByVal X, ByVal Path)
    If r Then
        pos = InStr(Path, Chr(0))
        GetFolderName = Left(Path, pos - 1)
    Else
        GetFolderName = ""
    End If
    
End Function


Sub TestGetFolderName()
Dim FolderName As String
    FolderName = GetFolderName("Select a folder")
    If FolderName = "" Then
        MsgBox "You didn't select a folder."
    Else
        MsgBox "You selected this folder: " & FolderName
    End If
End Sub

Sub ImportSensitivityData()

 'With ActiveSheet.QueryTables.Add(Connection:= _
        '"TEXT;C:\PBK1350ReceiverData\SN052375\SN052375_sensitivity.csv", Destination _
        ':=Cells)
        '.Name = "SN052375_sensitivity_1"


          With ActiveSheet.QueryTables
       
        
        
        .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 = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

[/QUOTE]