1

I got a code that merge two excel files to into one file. without save.

I select first with a dialogWindow a SourceFolder, I select then a TargetFolder with another dialogWindow.

I want instead of have two dialogwindows use One, to loop through a whole folder.

the filenames in the folder have this pattern see below: but the names can be almost anything, there is one thing that make them as a pair.

Se follow Filenames so see the pattern:

TEST_Translation2_jeeves_sv.xls
TEST_Translation2_jeeves_sv_NoTrans.xls

TEST_Translation2_UCHPResourcesCommon_de.xls
TEST_Translation2_UCHPResourcesCommon_de_NoTrans.xls

TEST_Translation2_creditDocument_ar.xls
TEST_Translation2_creditDocument_ar_NoTrans.xls

if the select the first file of the examples:

I want now to merge the sheet from "TEST_Translation2_jeeves_sv_NoTrans.xls" to "TEST_Translation2_jeeves_sv.xls" and save the file (TEST_Translation2_jeeves_sv.xls)

the script need to loop through a whole folder.

Could someone help me to modify my code?

Sub Combinles_Step1()    
'Declare Variables
Dim WorkbookDestination As Workbook
Dim WorkbookSource As Workbook
Dim WorksheetSource As Worksheet
Dim FolderLocation As String
Dim strFilename As String


With Application.FileDialog(msoFileDialogFolderPicker)

    .AllowMultiSelect = False
    .Title = "Select Source folder"
    If .Show = -1 Then

        Application.DisplayAlerts = False
        Application.EnableEvents = False
        Application.ScreenUpdating = False

        FolderLocation = .SelectedItems(1)

        'Dialog box to determine which files to use. Use ctrl+a to select all files in folder.
        SelectedFiles = Application.GetOpenFilename( _
            filefilter:="Excel Files (*.xls*), *.xls*", MultiSelect:=True)

        'Create a new workbook
        Set WorkbookDestination = Workbooks.Add(xlWBATWorksheet)
        strFilename = Dir(FolderLocation & "\*.xls", vbNormal)

        'Iterate for each file in folder
        If Len(strFilename) = 0 Then Exit Sub


        Do Until strFilename = ""

                Set WorkbookSource = Workbooks.Open(Filename:=FolderLocation & "\" & strFilename)
                Set WorksheetSource = WorkbookSource.Worksheets(1)
                WorksheetSource.Copy After:=WorkbookDestination.Worksheets(WorkbookDestination.Worksheets.Count)
                WorkbookSource.Close False
            strFilename = Dir()

        Loop
        WorkbookDestination.Worksheets(1).Delete

        Application.DisplayAlerts = True
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End With
End Sub

Thank you in advance

parakmiakos
  • 2,994
  • 9
  • 29
  • 43
XsiSecOfficial
  • 954
  • 8
  • 20

1 Answers1

1

Okay without getting into the code details:

Get the name of the file
Check to see if it contains the value "_NoTrans"
   If yes ignore it and move to the next
   Else the file name does not have the value "_NoTrans" then
      Take that name store it in a string variable
      Insert the "_NoTrans" value in front of the ".xls"
          Basically take the string value chop off the ".xls"
          Concatenate new string value + "_NoTrans" + ".xls"
              Note I do it in 3 pieces because "_NoTrans" should be a constant
              and ".xls" should also be a constant
Take the new filename variable and check if it exists
   If yes open it and work with it
   Else error

Hope that gets you moving the right direction

Okay not understanding -- would this not solve the situation? -- I mean all you have to do is apply VBA specific syntax to the above.

You are already getting the name of the file from what it looks like 
so it did not seem like you needed that explained.  

The next line is just a string compare function which you can find here
http://www.homeandlearn.org/text_and_excel_vba.html

The next 2 lines are simply an If / Else statement based on the results
of the string compare.

The next line pretty straight forward as well an assignment statement

The next 5 lines are just explaining a bit of simple string manipulations
InStr / Left / Dim y As String = "firstpart" + "middlepart" + "lastpart"
The above link will explain these if you do not understand them

The last 3 lines are just using the new name check to see if the file is
there which if you can open a file you should know how to check if a
file exists - yes/no?  if not go here
http://stackoverflow.com/questions/16351249/vba-check-if-file-exists

So that should finish the deal -- or are you saying you do not want to do the simple coding yourself ?? I mean I took it as you were just stuck on the how not the syntax of the how. With a bit of time I could easily translate the above into actual code but then I felt you could as well and I prefer to teach one to fish rather than just give you a fish.

Dennis Jensen
  • 214
  • 1
  • 14