VB bestanden opslaan in één werkmap

[Knollo]

Hallo,

Ik zet met de volgende code alle Excel-bestanden uit dezelfde bestandslocatie (map) in één Excel werkmap:

Sub GetSheets()
Path = "C:\gebruikers\ruud\telefoonlijsten\"
Filename = Dir(Path & "*.xlsx")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     Sheet.Copy After:=ThisWorkbook.Sheets(1)
  Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
End Sub

Kan iemand mij vertellen hoe ik deze code kan aanpassen zodat de reeds opgeslagen bestanden (en dus de reeds gemaakte worksheets) niet opnieuw worden toegevoegd?

Voorbeeld:
Ik krijg iedere week een telefoonlijst (xlsx-bestand) binnen als bijlage in een mail. Die bijlagen sla ik op in één bepaalde map. Ieder bestand is dus een xlsx-bestand met één werkblad. De naam van het werkblad is gelijk aan de bestandsnaam (bijv. V4a). Als ik in Excel deze lijsten ga verwerken, gebruik ik bovenstaande code om alle lijsten samen te voegen in één werkmap. Op dit moment zijn het 48 telefoonlijsten. Als daar deze week een nieuwe bij komt, slaat de code dus 49 xlsx-bestanden (waarvan 48 oud en 1 nieuw) op in de doelmap. Omdat de eerste 48 er al in stonden, maakt hij daar dus een nieuw tabblad voor aan met een (2). Ik wil dus graag ontdekken hoe de code kan checken of de bestandsnaam al bestaat als werkblad, en zo ja, deze overslaat.

Kan dat?

Bedankt,

Ruud.

 

[edmoor]

Je geeft de werkbladen nergens een naam. Als je dat doet en het werkblad de naam van het bestand geeft kan je daar op controleren of het werkblad al bestaat.
Die controle kan je dan doen met deze functie die een True of False terug geeft:

Function WorksheetExists(wsName As String) As Boolean
    WorksheetExists = Evaluate("ISREF('" & wsName & "'!A1)")
End Function

 

[VenA]

Zo?

Sub VenA()
  c00 = "C:\gebruikers\ruud\telefoonlijsten\"
  For Each Sh In Sheets
    c01 = c01 & Sh.Name
  Next Sh
  For Each it In Split(CreateObject("Wscript.Shell").Exec("cmd /c dir """ & c00 & "*.xlsx"" /b").StdOut.ReadAll, vbCrLf)
    If it = "" Then Exit Sub
    If InStr(c01, Split(it, ".")(0)) = 0 Then
      With GetObject(c00 & it)
        .Sheets(1).Copy , ThisWorkbook.Sheets(1)
        .Close 0
      End With
    End If
  Next it
End Sub

 

[Knollo]

Bedankt voor uw antwoorden. Ik ben helaas niet zo'n expert als gij, dus ik begrijp het nog niet helemaal.

Edmoor, is het de bedoeling dat ik die functie ergens in mijn code plak? Als ik dat doe, verandert End Sub automatisch in End Function.

VenA, is uw code een vervanging van de oude, of moet die ook ergens erin geplakt worden? Als ik uw code uitvoer, gebeurt er niets.

Excuses voor mijn onbegrip.

 

[edmoor]

Die functie set je uiteraard niet in de code van de sub maar er buiten. Die gebruik je dan zo:

If WorksheetExists(werkbladnaam) Then
    'De code als het werkblad bestaat
Else
    'De code als het werkblad niet bestaat
End If

 

[VenA]

Er stonden wat slordigheden in waardoor het niet werkte. Dit heb ik aangepast in #3.

 

[Knollo]

VenA, uw code werkt perfect. Dit was precies wat ik zocht. Hartelijk dank! Probleem opgelost, dit helpt mij enorm.

Edmoor, ook hartelijk dank, uw oplossing werkt ook ongetwijfeld, het is mijn onbegrip waar het op vastloopt. Ik zou graag willen doorgronden hoe het ook op deze manier kan lukken. Ik begrijp dat de functie controleert of een bepaald werkblad al aanwezig is. Alleen is de werkbladnaam niet statisch, ik weet dus niet goed wat ik moet invullen bij "werkbladnaam":

If WorksheetExists(werkbladnaam) Then
    'De code als het werkblad bestaat
Else
    'De code als het werkblad niet bestaat
End If

De code moet per bestand kijken of de werkbladnaam al bestaat, zo ja, dan NIET toevoegen, zo nee, dan WEL toevoegen. De "werkbladnaam" is dus telkens anders.
Bij de code van VenA werkt dit, zonder dat ik een werkbladnaam hoef in te vullen.

Nogmaals mijn excuses voor het onbegrip en hartelijk dank.

 

[edmoor]

Uiteraard is de werkbladnaam iedere keer anders, als dat niet zo was had je die controle niet nodig.
Zonder een goed voorbeeld is het nogal wat uitleg om te vertellen wat er gebeurt.
Je hebt al een goede oplossing en is dus nu niet nodig.

 

[VenA]

De Evaluate methode van @edmoor is eigenlijk wel eenvoudiger al zou ik geen Function maken voor 1 regel code

Sub VenA()
  c00 = "C:\gebruikers\ruud\telefoonlijsten\"
  For Each it In Split(CreateObject("Wscript.Shell").Exec("cmd /c dir """ & c00 & "*.xlsx"" /b").StdOut.ReadAll, vbCrLf)
    If it <> "" Then
      If IsError(Evaluate("'" & Split(it, ".")(0) & "'!A1")) Then
        With GetObject(c00 & it)
          .Sheets(1).Copy , ThisWorkbook.Sheets(1)
          .Close 0
        End With
      End If
    End If
  Next it
End Sub

Met Function

Function bladbestaatniet(c00)
  bladbestaatniet = IsError(Evaluate("'" & Split(c00, ".")(0) & "'!A1"))
End Function

Sub VenA()
  c00 = "C:\gebruikers\ruud\telefoonlijsten\"
  For Each it In Split(CreateObject("Wscript.Shell").Exec("cmd /c dir """ & c00 & "*.xlsx"" /b").StdOut.ReadAll, vbCrLf)
    If it <> "" Then
      If bladbestaatniet(Split(it, ".")(0)) Then
        With GetObject(c00 & it)
          .Sheets(1).Copy , ThisWorkbook.Sheets(1)
          .Close 0
        End With
      End If
    End If
  Next it
End Sub