Choose particular files from a directory

[Guest]

Hello,

Per the below, I'm trying to manipulate certain files within a directory.
As you can see in the last line, I am unsuccessfully trying to choose all
files in the directory entitled "Region***", as well as two specific files
("ABC.xls", "DEF.xls"). It works with just the Region, but not sure how to
get the syntax right to get the last two as well.....


TIA!




Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir

MyPath = "Y:\Sales\2005"
ChDrive MyPath
ChDir MyPath

FNames = Array(Dir("REGION***.xls"), "ABC.xls", "DEF.xls")

 

[Tim Williams]

Sub ProcessFiles()

dim sPath

sPath=Dir("Y:\Sales\2005\REGION***.xls")

do while sPath<>""
ProcessFile sPath
sPath=Dir()
loop

'process the other two files
ProcessFile "Y:\Sales\2005\ABC.xls"
ProcessFile "Y:\Sales\2005\DEF.xls"

end sub


Sub ProcessFile(sPath as string)
'process workbook code goes here
end sub


Tim.

 

[Gareth]

Hi Jeff,

You're doing a few things wrong in your code:

(1) Fnames should be a variant - this is required by the Array function.
(See VBA help.)

(2) Just doing Dir("REGION***.xls") will only ever return one file, you
need all the files correct? SO you have to do a loop to get them all.

(3) No need to do ***, just one * will suffice. Or do you mean you just
want files with 3 characters after region - in which case you shoudl be
using "region???.xls".

I've just written this and noticed Tim has posted a much simpler
solution - however, you may find my corrections to your code so I'll
post anyway. Below I've included code that may help you elsewhere.

HTH,
Gareth

Sub DOThings()

Dim Fnames As Variant
Dim i as integer
COnst myPath as string = "Y:\Sales\2005"

Fnames = fcnGetFileList(myPath, "Region*.xls")

'Either add the remaining files to your array
'or process them separately.

For i = 0 To UBound(v)
Debug.Print myPath & "\" & Fnames(i)
Next i


End Sub

Function fcnGetFileList(ByVal strPath As String, Optional strFilter As
String) As Variant
' Returns a one dimensional array with just one empty blank element if
no files found
' Otherwise returns list of files

Dim myFile As String
Dim i As Integer
Dim FileList() As String

If strFilter = "" Then strFilter = "*.*"

'check in case we were already passed a \ or /
Select Case Right$(strPath, 1)
Case "\", "/"
strPath = Left$(strPath, Len(strPath) - 1)
End Select

ReDim Preserve FileList(0)

myFile = Dir$(strPath & "\" & strFilter)
Do While Len(myFile) > 0
ReDim Preserve FileList(i) As String
FileList(i) = myFile
i = i + 1
myFile = Dir$()
Loop

fcnGetFileList = FileList

End Function

 

[Guest]

I apologize, but I am a novice trying to manipulate someone else's working
code. The below works (and the wildcards are intentional to choose a certain
type).... Within that directory, there are other specific files I'd like to
add -- that is where I get hung-up.

Am I better off just listing all the files that I wish to manipulate?
Thanks for the patience!




Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir

'-------- WHAT FOLDER? ------------------------------------------
MyPath = "Y:\Sales\Target Customer\2005 Mainframe Download - Main"
ChDrive MyPath
ChDir MyPath
'------------------------------------------------------------


'--------- WHICH FILES? ------------------------------------------
'
FNames = Dir("CO*RG***-0*.xls")

If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Sheets("REG").Visible = True


With Application
..Calculation = xlManual
End With


Application.ScreenUpdating = False


'*** Declare Basebook **************
Set basebook = ThisWorkbook

'*** Clears all cells on the first sheet
basebook.Worksheets(2).Cells.Clear

rnum = 1

Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)

Set sourceRange = mybook.Worksheets(2).Range("C688:FO688")

SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, "B")


'***********************************************************
basebook.Worksheets(2).Cells(rnum, "A").Value =
mybook.Worksheets(1).Range("F2") & " : " & mybook.Worksheets(1).Range("AU2")


With sourceRange
Set destrange = basebook.Worksheets(2).Cells(rnum, "B"). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value

mybook.Close False
rnum = rnum + SourceRcount
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True


Worksheets(2).Select

Bunch of formatting........


End Sub

 

[Tim Williams]

Jeff,

Are you only copying a single row from each source file ? That's how the
code you posted appears to function.
If so, it could be simplified quite a bit....

You can contact me offline if you want to follow up on this by email.
domain is "gmail" and I'm "timjwilliams"

Tim