Problem with combining workbooks.

[jaynorman46]

Hi,
Im new to this forum and am sorry if this question has been asked already..

I have code that combines multiple workbooks into a single sheet, However the problem is the order that they are combined. All of these files are in a single folder and there is no other type of file in the folder, also all files are .xlsm and not .xlsx. I have renamed all of them using the alt+255 function so that all of the of the files are

(1).xlsm
(2).xlsm
(3).xlsm
etc... all the way to (339).xlsm

The problem,

the code imports in this order

(1).xlsm
(10).xlsm
(100).xlsm
(101).xlsm
etc....

and I need it in 1,2,3,4 order

Is there anything I can do about this? I have tried multiple different types of Loops and posted codes for this and they all do the same order..

Here is the code(based off of schielrn (Board Regular) code post Jan 18th, 2008, 12:05 PM):


Sub MergeFiles()
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range

ThisWB = ActiveWorkbook.Name

Set wbDest = ActiveWorkbook




path = ("C:\Documents and Settings\JNorma1\My Documents\Happy Jack Daily site reports 2010")
Application.EnableEvents = False
Application.ScreenUpdating = False
Set shtDest = ActiveWorkbook.Sheets("Upload File")
Filename = Dir(path & "\*.xls", vbNormal)

If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Set CopyRng = Wkb.Sheets(1).Range("G31:N45")
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy
wbDest.Activate

Sheets("Upload File").Select
Dest.PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False 'Clear Clipboard
Wkb.Close True


End If

Filename = Dir()
Loop


Range("A1").Select

Application.EnableEvents = True
Application.ScreenUpdating = True

MsgBox "Done!"

End Sub

 

[jaynorman46]

You should also know that the 6 files in January (25-31) are already named with the preceding "0" 01-25 however those are the only 6 files (out of all of the files in folder) that are named as such.

 

[Joe4]

Hmmm...
That's very odd. It is finding the file, I do not know why it isn't renaming it. I recreated a similar scenario on my side, and it worked just fine.

Try this code and tell me what it returns

Sub MyTest()
   MsgBox RenameDate("HPJ Daily Report 2010 01-25.xlsm")
End Sub

That should at least tell us if the UDF is working properly.

 

[jaynorman46]

I tested it, I even created a bogus file (HPJ Daily Report 2010 1-21.xlsm)

and


Sub MyTest()
MsgBox RenameDate("HPJ Daily Report 2010 1-21.xlsm")
End Sub


Worked perfectly fine, I got "HPJ Daily Report 2010-01-21.xlsm"

 

[Joe4]

If the file is read-only, protected or open at the time, it might not let you rename it. That may be what is going on. Did you check that?

 

[jaynorman46]

Yes, all these files are non read only, unrestricted access and closed. I stepped through every line of code and put a msgbox after

RenameDate = Left(myFileName, 17) & myDate & ed

and got the correct output.

Im thinking there is a syntax error with

Name MyFile As RenameDate(MyFile)

 

[Joe4]

Maybe. By the fact you are using "xlsm" files, I am assuming that you must be using Excel 2007 or 2010. Is that correct? It isn't the Mac version, is it?

Pick any xlsm file on your system and try renaming it directly using the NAME method and see if it works, as a test, i.e.

Sub MyRenameTest()
    Name "C:\Files\My Test.xlsm" "C:\Files\My New Test.xlsm"
End If

I would try one with and without a space in the file name to see if that makes any difference.

 

[jaynorman46]

Allright I can try that, Unfortunately I have to go home for the day... Thanks for all your help and I look forward to hearing from you again!!

 

[jaynorman46]

so i tried the test,

Sub MyRenameTest()
Name "C:\Documents and Settings\JNorma1\My Documents\Test\Book 2.xlsx" As "C:\Documents and Settings\JNorma1\My Documents\Test\Test.xlsx"

End Sub
It gave me a File Not found

 

[jaynorman46]

I have found the solution to this problem, after a little tinkering i discovered that the reason the file was not found id that it had no path to look in...

Sub MyRenameFiles()
    Dim myDate As String
    
    Dim ed As String
    Dim RenameDate As String
 
    Dim MyFolder As String
    Dim MyFile As String
    
'   Enter your folder name here
    MyFolder = "C:\Documents and Settings\JNorma1\My Documents\Happy Jack Daily site reports 2010\"
    
    
    
'   Loop through all xlsm files and rename
   MyFile = Dir(MyFolder & "*.xlsm")

    Do While Len(MyFile) > 0
        
    MyFile = Dir(MyFolder & "*.xlsm")
    
    ed = ".xlsm"
    
'   Pull out date portion (date starts in space 18, and extension is 4 characters)
    myDate = Mid(MyFile, 18, Len(MyFile) - 18 - 4)
    
'   Replace spaces with dash
    myDate = Replace(myDate, " ", "-")
    
'   Insert 0 in month, if missing
    If Mid(myDate, 7, 1) = "-" Then
        myDate = Left(myDate, 5) & "0" & Right(myDate, Len(myDate) - 5)
    End If
    
'   Insert 0 in day, if missing
    If Len(myDate) = 9 Then
        myDate = Left(myDate, 8) & "0" & Right(myDate, 1)
    End If
    
    RenameDate = Left(MyFile, 17) & myDate & ed
    
    
    
    Name MyFolder & MyFile As MyFolder & RenameDate
    
    
    Loop
    
    MsgBox "Files renamed!"
    
End Sub