[VBA / excel 2007] samenvoegen bestanden maar 1 bestand niet

[raoel]

Ik ben bezig met een script dat alle excel bestanden in een map in 1 bestand zet, maar 1 bestand moet niet meegenomen worden. Dat laatste is het probleem en ondanks een hoop zoekwerk en wat probeerwerk krijg ik het niet voor elkaar.

/ik ben dan ook geen vba kenner

Het script heb ik grootendeels van deze website:
http://www.rondebruin.nl
http://www.rondebruin.nl/copy3.htm

Met behulp van wat gegoogle heb ik al een paar dingen aangepast zodat de filters in de bestanden automatisch uit worden gezet en dat een eventuele read only met true beantwoord wordt. Dat werkt allemaal netjes, maar nu nog een toevoeging dat ik een bepaald bestand weg kan laten laten uit de "merge".

Dat bestand is een overview die wat tellers uit alle andere bestanden uitleest. Ik heb het al een andere extensie gegeven: *.xlsm. En toch leest het script het bestand in.

In onderstaand script staat:
FilesInPath = Dir(MyPath & "*.xls")

Wat eerst het volgende was
FilesInPath = Dir(MyPath & "*.xl*")

Ik had verwacht dat het daardoor de xlsm niet mee zou nemen, maar helaas. Het is voldoende als de xlsm niet meegenomen wordt, maar nog mooier als je de bestandsnaam (nog mooier) bestandnamen erin kunt verwerken. Dan kan het gewoon een .xls blijven.

Visual Basic:

' Change this to the path\folder location of your files.
    MyPath = "C:\bla bla bla"

    ' Add a slash at the end of the path if needed.
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If

    ' If there are no Excel files in the folder, exit.
    FilesInPath = Dir(MyPath & "*.xls")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    ' Fill the myFiles array with the list of Excel files
    ' in the search folder.
    FNum = 0
    Do While FilesInPath <> ""
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        MyFiles(FNum) = FilesInPath
        FilesInPath = Dir()
    Loop

    ' Set various application properties.
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Add a new workbook with one sheet.
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    rnum = 1

    ' Loop through all files in the myFiles array.
    If FNum > 0 Then
        For FNum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(MyPath & MyFiles(FNum), ReadOnly:=True, UpdateLinks:=0)
            On Error GoTo 0
            
            With ActiveSheet
            If .AutoFilterMode Then
            If .FilterMode Then
            .ShowAllData
            End If
            Else
            If .FilterMode Then
            .ShowAllData
            End If
            End If
            End With


            If Not mybook Is Nothing Then
                On Error Resume Next
                
                ' Change this range to fit your own needs.
                With mybook.Worksheets(1)
                    
                   FirstCell = "A26"
                   Set sourceRange = .Range(FirstCell & ":" & RDB_Last(3, .Cells))
                   ' Test if the row of the last cell is equal to or greater than the row of the first cell.
                   If RDB_Last(1, .Cells) < .Range(FirstCell).Row Then
                      Set sourceRange = Nothing
                   End If
                End With

en nog een hoop

[onkl]

Zou moeten werken. Vreemd dus. Maar dit werkt ook, als het goed is:

Visual Basic:

[...]
    Do While FilesInPath <> ""
        If not FilesInPath = "C:\blabla\telbestandje.xls" then
           FNum = FNum + 1
           ReDim Preserve MyFiles(1 To FNum)
           MyFiles(FNum) = FilesInPath
        end if
        FilesInPath = Dir()
    Loop
[...]

[ Voor 12% gewijzigd door onkl op 25-09-2008 14:05 ]

[raoel]

Bedankt voor de snelle reactie, maar helaas, het xlsm bestand wordt nog steeds meegenomen in de merge.

Eigenwijze VBA heb ik...

[Verwijderd]

je doet iets niet juist. misschien heb je hetzelfde bestand dat je wil uitsluiten in die directory zowel met xls & xlsm extensie staan. het voorbeeld van onkl moet natuurlijk aangepast worden volgens jouw behoefte :

Visual Basic:

If not FilesInPath = "C:\voorbeeld\van\hetuitetesluitenbestand.xlsm" then 

[raoel]

Ik heb onderstaande code. Dat is het juiste pad (als ik het in explorer copy/paste dan wordt het geopend, kan dus niet fout zijn). Het bestand staat maar 1 keer in de folder.

Visual Basic:

FNum = 0
    Do While FilesInPath <> ""
        If Not FilesInPath = "C:\test\tel_bestand_1.xlsm" Then
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        MyFiles(FNum) = FilesInPath
        End If
        FilesInPath = Dir()
    Loop

Om iets te testen heb ik het volgende gedaan: "*.xls" veranderd in "*.xlsm".
Zie onderstaande code. Wat doet de macro. Hij laat de xls netjes uit de merge weg, dat klopt dus eigenlijk wel.
Zie onderstaande code:

Daarnaast heb ik een keer het xlsm bestand weggehaald. Een ander bestand zo ingevuld dat het niet meegenomen zou moeten worden. Toch gebeurd dat wel.

Visual Basic:

    ' If there are no Excel files in the folder, exit.
    FilesInPath = Dir(MyPath & "*.xlsm")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    ' Fill the myFiles array with the list of Excel files
    ' in the search folder.
    FNum = 0
    Do While FilesInPath <> ""
        If Not FilesInPath = "C:\test\tel_bestand_1.xlsm" Then
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        MyFiles(FNum) = FilesInPath
        End If
        FilesInPath = Dir()
    Loop

Kan het misschien met de header te maken hebben?
Of met spaties in de bestandsnamen?

Visual Basic:

Sub MergeAllWorkbooks()
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceRcount As Long, FNum As Long
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim rnum As Long, CalcMode As Long

[Verwijderd]

nee, het probleem is dat dir enkel de bestandsnaam zonder pad teruggeeft. de test mag dus geen schijfletter noch mapverwijzing bevatten.

[raoel]

Ik wilde nog even laten weten dat het goed is gekomen door de reactie van _heretic_. Bedankt daarvoor.

Bij de regel:
If not FilesInPath = "tel_bestand_1.xlsm" then
Moet niet het pad voor de bestandsnaam staan. Zie code onderaan.

Overigens heb ik het zo opgelost:
MyPath = Range("B3")
en
If Not FilesInPath = Range("B13") Then
zodat mensen het pad en het weg te laten bestand in de excel sheet in kunnen vullen.

Wel vindt ik het vreemd dat het *.xlsm bestand mee wordt genomen terwijl in het script met deze regel:
FilesInPath = Dir(MyPath & "*.xls")
toch echt alleen naar *.xls bestanden gekeken zou moeten worden.
Kan iemand mij dat uitleggen?
-
-

Visual Basic:

' Change this to the path\folder location of your files.
    MyPath = "C:\test\"

    ' Add a slash at the end of the path if needed.
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If

    ' If there are no Excel files in the folder, exit.
    FilesInPath = Dir(MyPath & "*.xls")
    If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

    ' Fill the myFiles array with the list of Excel files
    ' in the search folder.
    FNum = 0
    Do While FilesInPath <> "" 
        If not FilesInPath = "tel_bestand_1.xlsm" then 
           FNum = FNum + 1 
           ReDim Preserve MyFiles(1 To FNum) 
           MyFiles(FNum) = FilesInPath 
        end if 
        FilesInPath = Dir() 
    Loop

en nog een hoop