LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
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
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Wildcards and if Arlene Excel Worksheet Functions 3 June 21st 07 12:05 AM
Wildcards irresistible007 Excel Worksheet Functions 2 December 20th 05 10:12 AM
wildcards in vba shellshock Excel Discussion (Misc queries) 3 July 21st 05 07:37 PM
Wildcards properties Excel Programming 3 May 19th 04 05:04 PM
Wildcards john Petty Excel Programming 3 August 22nd 03 08:57 PM


All times are GMT +1. The time now is 01:42 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"