View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
BoRed79 BoRed79 is offline
external usenet poster
 
Posts: 30
Default 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