Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Wildcards and Looping
I have some code (see below) which is attempting to open each text file in a
folder (chosen by the user), save it as an excel file and then copy its contents to a master file. All of the files are named the same (i.e. 1.1 Name 1, 1.1 Name 2 etc etc), so I want the macro to loop through the folder finding all of the files that begin 1.1 and then perform the action. I think thought that I must be using the wildcards incorrectly as the macro does not seem to be performing any actions. Can anyone advise where I might be going wrong. Thanks. Liz. Code being used: '32-bit API declarations (BT) Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Public Type BROWSEINFO 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 Sub Provider() 'Switch off screen flashing Application.ScreenUpdating = False 'Request the user to select the latest provider data Msg = "Select the folder containing the latest PROVIDER data" DDirectory = GetDirectory(Msg) If DDirectory = "" Then Exit Sub If Right(DDirectory, 1) < "\" Then DDirectory = DDirectory & "\" a = MsgBox(Prompt:=DDirectory, Buttons:=vbOKOnly) 'Open each text file, save it as an excel file and copy it into the analysis model ChDir DDirectory Do While Filename = "1.1 *.txt" Workbooks.OpenText Filename:="1.1 *.txt" _ , Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _ Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _ Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _ , 1), Array(16, 1)), TrailingMinusNumbers:=True ActiveWorkbook.SaveAs Filename:=LocalFileName _ , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False Range("A2").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Copy Windows("Cancer monitoring (Provider).xls").Activate Sheets("1.1 ReportDownload").Visible = True Sheets("1.1 ReportDownload").Select Sheets("1.1 ReportDownload").Range("B65536").End(xlUp).Offset( 1, -1).Select ActiveSheet.Paste Sheets("1.1 ReportDownload").Range("B65536").End(xlUp).Offset( 1, -1).Select Sheets("1.1 ReportDownload").Visible = False ActiveWorkbook.Save Windows("1.1 *.xls").Activate ActiveWorkbook.Close Loop Switch on screen flashing Application.ScreenUpdating = True End Sub 'More BT declarations Function GetDirectory(Optional Msg) As String Dim bInfo As BROWSEINFO Dim path As String Dim r As Long, x As Long, pos As Integer ' Root folder = Desktop bInfo.pidlRoot = 0& ' Title in the dialog If IsMissing(Msg) Then bInfo.lpszTitle = "Select a folder." Else bInfo.lpszTitle = Msg End If ' Type of directory to return bInfo.ulFlags = &H1 ' Display the dialog x = SHBrowseForFolder(bInfo) ' Parse the result path = Space$(512) r = SHGetPathFromIDList(ByVal x, ByVal path) If r Then pos = InStr(path, Chr$(0)) GetDirectory = Left(path, pos - 1) Else GetDirectory = "" End If End Function |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Wildcards and if | Excel Worksheet Functions | |||
Wildcards | Excel Worksheet Functions | |||
wildcards in vba | Excel Discussion (Misc queries) | |||
Wildcards | Excel Programming | |||
Wildcards | Excel Programming |