I've created a series of workbooks by using a macro to filter out data
and export it to a workbook for two separate tasks. I now have 2
folders each with a series of workbooks (Folder 1 & Folder 2). Folder
1 is the non-salary budget file and Folder 2 is the salary budget
file.

The file names are in the format of 234-2340100-101-99999999.xls in
Folder 1 and in Folder 2 its 234-2340100-101-99999999 - salary.xls

What I'm hoping to do, primarily to save time, is to automate it
rather than doing it manually (52 workbooks). What I would like to do
is to run a macro that will

A) Look at a workbook in Folder 1, if its finds a match in Folder 2
(trim " - salary.xls") it will copy the worksheet from the workbook in
Folder 2 into the workbook in Folder, save the file in a new directory
(OUTPUT) and add the text " - done" to the file in Folder 2. (That way
I can identify if there is a file in Folder 2 which doesn't have a
corresponding file in Folder 1)
B) If there isn't a matching workbook in Folder 2, it will save the
workbook from Folder 1 into the output directory.
C) If there is a workbook in Folder 2 and there is no matching
workbook in Folder 1 then it would save the workbook in the Output
folder.

I believe this would be possible, but I'm not sure how to do it.

Forgone,

There is quite a bit of code below, including two API calls, so you'll have
to test and audit the code extensively (especially since I don't know what
your file/folder structures look like). Keep in mind though, that if you run
the code in its current state, you may get unexpected results, which you'll
have to manually reverse. I suggest debugging the code via F8 (i.e.
Debug|Step Into) and/or F9 (i.e. Debug|Toggle Breakpoint). The code has not
been extensively tested, so again, be sure to test for appropriate results.
Some of the code could be simplified via loops and/or other coding
structures, but I figured that drawing it out might be of more help to you.

Best,

Matthew Herbert


Private Const BIF_RETURNONLYFSDIRS As Long = &H1

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

Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
ByVal pidl As Long, _
ByVal pszBuffer As String) As Long

Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
lpBrowseInfo As BROWSEINFO) As Long

Public Enum FileInformation
Folder
BaseExtName
BaseName
Extension
End Enum

Sub TestingIt()
Dim strFolderOne As String
Dim strFolderTwo As String
Dim strFolderNew As String
Dim strFolder As String
Dim strArrOneFiles() As String
Dim strArrTwoFiles() As String
Dim strTemp As String
Dim strFile As String
Dim strFileOne As String
Dim strFileTwo As String
Dim intCnt As Integer
Dim intSpot As Integer
Dim varMatch As Variant
Dim wkbOne As Workbook
Dim wksOne As Worksheet
Dim wkbTwo As Workbook
Dim wksTwo As Worksheet
Dim strExt As String
Dim strCompare As String

strExt = ".xls"
strCompare = " - salary"

strFolderOne = BrowseForFolder("Get Folder1")
If strFolderOne = "" Or Not IsFolder(strFolderOne) Then
MsgBox "You selected an invalid folder."
Exit Sub
End If

strFolderTwo = BrowseForFolder("Get Folder2")
If strFolderTwo = "" Or Not IsFolder(strFolderTwo) Then
MsgBox "You selected an invalid folder."
Exit Sub
End If

strFolderNew = BrowseForFolder("Get New Output Folder")
If strFolderNew = "" Or Not IsFolder(strFolderNew) Then
MsgBox "You selected an invalid folder."
Exit Sub
End If

strFolderOne = FolderBackslash(strFolderOne)
strFolderTwo = FolderBackslash(strFolderTwo)
strFolderNew = FolderBackslash(strFolderNew)

strFile = Dir(strFolderOne & "*" & strExt)
intCnt = 0
Do Until strFile = vbNullString
ReDim Preserve strArrOneFiles(intCnt)
strTemp = ReturnFileInformation(strFolderOne & strFile, BaseName)
strArrOneFiles(intCnt) = strTemp
intCnt = intCnt + 1
strFile = Dir()
Loop

strFile = Dir(strFolderTwo & "*" & strExt)
intCnt = 0
Do Until strFile = vbNullString
ReDim Preserve strArrTwoFiles(intCnt)
strTemp = ReturnFileInformation(strFolderTwo & strFile, BaseName)
intSpot = InStr(1, strTemp, strCompare, vbTextCompare)
If intSpot < 0 Then
strTemp = Left(strTemp, intSpot - 1)
strArrTwoFiles(intCnt) = strTemp
intCnt = intCnt + 1
End If
strFile = Dir()
Loop

For intCnt = LBound(strArrOneFiles) To UBound(strArrOneFiles)
strFileOne = strArrOneFiles(intCnt)
varMatch = Application.Match(strFileOne, strArrTwoFiles, 0)
If IsError(varMatch) Then
'copy the file, or rename it?
'FileCopy strFolderOne & strFileOne & strExt, strFolderNew &
strFileOne & strExt
'Name strFolderOne & strFileOne & strExt As strFolderNew &
strFileOne & strExt
Else
'copy wks from Folder2 into Folder1 wkb?
strFileTwo = strArrTwoFiles(varMatch - 1)
strFile = strFolderTwo & strFileTwo & strCompare & strExt

Set wkbTwo = Workbooks.Open(strFile)
Set wksTwo = wkbTwo.Worksheets(1)

strFile = strFolderOne & strFileOne & strExt
Set wkbOne = Workbooks.Open(strFileOne)
Set wksOne = wkbOne.Worksheets(1)

wksTwo.Copy Befo=wksOne
strFile = strFolderTwo & strFileTwo & " - done" & strExt
wkbTwo.SaveAs strFile

wkbOne.Close False
wkbTwo.Close True
End If
Next intCnt

For intCnt = LBound(strArrTwoFiles) To UBound(strArrTwoFiles)
strFileTwo = strArrTwoFiles(intCnt)
varMatch = Application.Match(strFileTwo, strArrOneFiles, 0)
If IsError(varMatch) Then
'copy the file, or rename it?
'FileCopy strFolderTwo & strFileTwo & strCompare & strExt,
strFolderNew & strFileTwo & strExt
'Name strFolderTwo & strFileTwo & strCompare & strExt As
strFolderNew & strFileTwo & strExt
End If
Next intCnt

End Sub
Function BrowseForFolder(Optional strCaption As String = "") As String
Dim BI As BROWSEINFO
Dim strFolderName As String
Dim lngID As Long
Dim lngRes As Long

With BI
.pszDisplayName = String$(256, vbNullChar)
.lpszTitle = strCaption
.ulFlags = BIF_RETURNONLYFSDIRS
End With

strFolderName = String$(256, vbNullChar)
lngID = SHBrowseForFolderA(BI)
If lngID < 0 Then
lngRes = SHGetPathFromIDListA(lngID, strFolderName)
If lngRes < 0 Then
BrowseForFolder = Left$(strFolderName, InStr(strFolderName,
vbNullChar) - 1)
End If
End If

End Function

Function IsFolder(strPath As String) As Boolean
Dim strFolder As String

On Error Resume Next
strFolder = Dir(strPath, vbDirectory)
If strFolder < "" Then
If (GetAttr(strFolder) And vbDirectory) = vbDirectory Then
IsFolder = True
End If
End If
End Function

Function ReturnFileInformation(strFileName As String, _
lngFileInfo As FileInformation) As String
Dim strFolder As String
Dim strBaseExtName As String
Dim strBaseName As String
Dim strExtension As String
Dim intSpot As Integer

intSpot = InStrRev(strFileName, "\", , vbTextCompare)

If intSpot = 0 Then
ReturnFileInformation = ""
Exit Function
End If

strFolder = Left(strFileName, intSpot - 1)
strBaseExtName = Right(strFileName, Len(strFileName) - intSpot)
intSpot = InStrRev(strBaseExtName, ".", , vbTextCompare)
strBaseName = Left(strBaseExtName, intSpot - 1)
strExtension = Right(strBaseExtName, Len(strBaseExtName) - intSpot)

Select Case lngFileInfo
Case Folder
ReturnFileInformation = strFolder
Case BaseExtName
ReturnFileInformation = strBaseExtName
Case BaseName
ReturnFileInformation = strBaseName
Case Extension
ReturnFileInformation = strExtension
End Select

End Function

Function FolderBackslash(strFolder As String) As String
If Right(strFolder, 1) < "\" Then strFolder = strFolder & "\"
FolderBackslash = strFolder
End Function


"Forgone" wrote:

I've created a series of workbooks by using a macro to filter out data
and export it to a workbook for two separate tasks. I now have 2
folders each with a series of workbooks (Folder 1 & Folder 2). Folder
1 is the non-salary budget file and Folder 2 is the salary budget
file.

The file names are in the format of 234-2340100-101-99999999.xls in
Folder 1 and in Folder 2 its 234-2340100-101-99999999 - salary.xls

What I'm hoping to do, primarily to save time, is to automate it
rather than doing it manually (52 workbooks). What I would like to do
is to run a macro that will

A) Look at a workbook in Folder 1, if its finds a match in Folder 2
(trim " - salary.xls") it will copy the worksheet from the workbook in
Folder 2 into the workbook in Folder, save the file in a new directory
(OUTPUT) and add the text " - done" to the file in Folder 2. (That way
I can identify if there is a file in Folder 2 which doesn't have a
corresponding file in Folder 1)
B) If there isn't a matching workbook in Folder 2, it will save the
workbook from Folder 1 into the output directory.
C) If there is a workbook in Folder 2 and there is no matching
workbook in Folder 1 then it would save the workbook in the Output
folder.

I believe this would be possible, but I'm not sure how to do it.
.

Hi Matthew,

WOW!!!! That is a lot of code...... I will give it a test run. That is
fantastic! Cheers for that.... Thanks again!