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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Wildcards and Looping
One possible approach would be something like:
if Left(Filename,4) = "1.1 " then... If you may have non-txt files that start with 1.1, then you could always just limit your search to txt files (I don't have the code for this at my fingertips, but you should be able to limit returned results) or just add an "and" condition if you are returning a full filename including the extension: if Left(Filename,4) = "1.1 " and Right(Filename, 4) = ".txt" then... "BoRed79" wrote: 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Wildcards and Looping
This is what I would do....
Option Explicit '============================================== ' Sub Purpose: Get the provider text file and make xls file ' '============================================== ' Public Sub GetProvider() Dim blnSubFolders As Boolean Dim k As Long, j As Long Dim strArr() As String Dim Filename As String Dim LocalFileName As String Dim strFileNameFilter As String Dim varAnswer As String Dim Msg As String Dim strName As String Dim strDirectory As String, strPath As String Dim varSubFolders As Variant Dim i As Long On Error Resume Next '- - - - V A R I A B L E S - - - - - - - - - Filename = "1.1*.txt" varSubFolders = vbNo blnSubFolders = False '- - - - - - - - - - - - - - - - - - - - - - strFileNameFilter = _ InputBox( _ "Select the folder containing the latest PROVIDER data" _ & vbCr, _ "Enter file name to match:", Default:=Filename) If Len(strFileNameFilter) = 0 Then GoTo Exit_ListFiles End If Msg = "Select location of files to be " & _ "processed or press Cancel." 'Allow user to select folder(s) With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .InitialFileName = Left(ActiveWorkbook.FullName, _ Len(ActiveWorkbook.FullName) - Len(ActiveWorkbook.Name)) .Title = Msg .Show strDirectory = .SelectedItems(1) End With If strDirectory = "" Then Exit Sub End If If Right(strDirectory, 1) < Application.PathSeparator Then strDirectory = strDirectory & Application.PathSeparator End If 'get 1st filename strName = Dir(strDirectory & strFileNameFilter) On Error Resume Next 'get # of files meeting correct filter j = 0 Do While strName < vbNullString j = j + 1 strName = Dir() Loop ReDim strArr(1 To j) 'put filenames and file info into array strName = Dir(strDirectory & strFileNameFilter) k = 0 Do While strName < vbNullString k = k + 1 strArr(k) = strDirectory & strName strName = Dir() Loop If k 0 Then For i = 1 To k Workbooks.OpenText Filename:=strArr(i) _ , 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 LocalFileName = Left(strArr(i), Len(strArr(i)) - 4) 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 Next i End If Exit_ListFiles: Application.StatusBar = False Exit Sub Err_ListFiles: MsgBox "Error: " & Err & " - " & Err.Description Resume Exit_ListFiles End Sub '============================================== -- Hope this helps. If it does, please click the Yes button. Thanks in advance for your feedback. Gary Brown "BoRed79" wrote: 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 |
Reply |
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 |