12.02.2015, 15:46
Hallo zusammen,
bräuchte mal dringend Hilfe. Folgendes Problem: Beim Start der Excel Datei wird über Workbook open nachfolgender Code ausgelöst.
Nun wollte ich im Array Bereich zu den 22 Pfaden 5 Pfade neue hinzufügen, da kam nachfolgende Meldung: "zu viele Zeilenfortsetzungen"
Wie muss ich den Code ändern damit ich jederzeit neue Pfade hinzufügen kann?
Großes Danke im Voraus!!!
bräuchte mal dringend Hilfe. Folgendes Problem: Beim Start der Excel Datei wird über Workbook open nachfolgender Code ausgelöst.
Code:
Option Explicit
Private Sub Workbook_Open()
Dim arrPfad(), strPfad
Dim intJahr As Integer
Dim t As Long 'Tabellen#
Dim c As Long 'Spalten#
Dim rng As Range 'Zelle mit Datum
Dim vntTabellenAuswahl As Variant
intJahr = Year(Date)
arrPfad = Array("D:\Firma\Abrechnungen\" _
"D:\Firma\Anfragen-Online\" _
"D:\Firma\Angebote\" _
"D:\Firma\Berechnungen\" _
.
. usw. 22 Zeile insgesamt
.
"D:\Firma\Schriftwechsel\Email\Kunden\")
For Each strPfad In arrPfad
If Dir(strPfad & intJahr, vbDirectory) = "" Then MkDir strPfad & intJahr
Next
vntTabellenAuswahl = Array("Tab1", "Tab2") 'Die Namen bitte anpassen!
For t = 0 To UBound(vntTabellenAuswahl)
With Worksheets(vntTabellenAuswahl(t))
On Error Resume Next
c = WorksheetFunction.Match("Ablauf", .Range(.Cells(2, 1), .Cells(2, .Cells(2, .Columns.Count).End(xlToLeft).Column)), 0)
If Err.Number <> 0 Then
'no action - bei Fehler Blatt ignorieren
Else
Set rng = .Cells(3, c) 'Zelle mit Datum
If IsDate(rng) Then
If DateDiff("d", Now, rng) <= 90 Then
rng = DateSerial(Year(rng) + 1, Month(rng), Day(rng)) 'Frist < 3 Monate, Jahr um 1 erhöhen
End If
End If
End If
On Error GoTo 0
End With
Next t
Application.WindowState = xlMinimized
frm_Kundenliste.Show vbModeless
Geburtstag
End Sub
Nun wollte ich im Array Bereich zu den 22 Pfaden 5 Pfade neue hinzufügen, da kam nachfolgende Meldung: "zu viele Zeilenfortsetzungen"
Wie muss ich den Code ändern damit ich jederzeit neue Pfade hinzufügen kann?
Großes Danke im Voraus!!!
Grüße aus Bremen
Bernie
"Wenn du jemanden triffst ohne lächeln, schenke ihm deins !!!"
MS Office 2016 Pro 32bit - Win 10 Pro 64 bit
Haftungshinweis: Trotz sorgfältiger inhaltlicher Kontrolle übernehmen ich keine Haftung für die Inhalte externer Links. Für den Inhalt der verlinkten Seiten sind ausschließlich deren Betreiber verantwortlich.
Bernie
"Wenn du jemanden triffst ohne lächeln, schenke ihm deins !!!"
MS Office 2016 Pro 32bit - Win 10 Pro 64 bit
Haftungshinweis: Trotz sorgfältiger inhaltlicher Kontrolle übernehmen ich keine Haftung für die Inhalte externer Links. Für den Inhalt der verlinkten Seiten sind ausschließlich deren Betreiber verantwortlich.