Aus Excel Tabelle Ordner mit Datei erstellen - inkl. Hyperlink und Verknüpfung

Question

Hallo zusammen,

ich versuche mir gerade eine Art CRM Programm mit Excel zu bauen.

In der ersten Excel-Tabelle habe ich eine Übersicht mit laufender Nummer, Name, Plz und Ort und einer zusätzlichen Spalte mit Wiedervorlage. Wird in eine neue Zeile ein Name eingetragen erstellt ein VBA einen neuen Ordner. Dieser erhält den Namen der lf.Nr. mit „Aktivitäten“ und „Schriftverkehr“.

In den Ordner „Aktivitäten“„ wird eine Excel-Tabelle namens „Akt.xlsm“ eingefügt. In diese sollen alle Details eingetragen werden. U.a. auch ein Wiedervorlagedatum. In der Zelle I11 ist eine Formel hinterlegt, die das nächste Datum aus anzeigt. Die Excel-Datei ist im Übergeordneten Ordner „Inhalt“ als Vorlage hinterlegt.

Nun meine Fragen:

1. Wie bekomme ich den Inhalt der Zelle I11 aus der Excel-Tabelle namens „„Akt.xlsm“„ aus dem passend erstellen Ordner in die passende Zeile (Spalte X) der Übersicht-Tabelle.

2. Wie bekomme ich einen Hyperlink aus der Excel-Tabelle „„Akt.xlsm“„ zum passend erstellten Ordner Schriftverkehr.

Ich hoffe, das war nicht zu verwirrend erklärt.

Den Ordneraufbau habe ich folgend aufgebaut:

->Ordner CRM
-> Ordner Inhalt (enthält Vorlage Excel-Datei „Akt.xlsm“)
-> Ordner Kunden (hier wird je Name ein Ordner erstellt (Ordnerbezeichnung = lfd. Nr.)
->Ordner „Aktivitäten“ - beinhaltet Datei „Akt.xlsm“
->Ordner „Schriftverkehr“„ - dort sollen Schriftstücke gespeichert werden



Vielen Dank schon mal für eure Hilfe

Gruß
Florian

Answer 1

Hallo Florian,

ich würde das Makro "OrdnerAnlegen" im WITH-Block wie folgt ergänzen (nachdem die Verzeichnisse angelegt und die Datei Akte.xslm kopiert wurde):

For Each Zelle In .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))

If Dir$(cstPfad & strKundenOrdner & "\" & Zelle, vbDirectory) = vbNullString Then

'... Code

End If

'Datei öffnen
Workbooks.Open (strAktivitäten & "\Akt.xlsm")
'Daten kopieren
Workbooks("Akt.xlsm").Worksheets("Tabelle1").Cells(1, 2) = .Cells(Zelle.Row, 2)
Workbooks("Akt.xlsm").Worksheets("Tabelle1").Cells(3, 2) = .Cells(Zelle.Row, 3) & " " & .Cells(Zelle.Row, 4)

'Akte.xlsm speichern und schließen
With Workbooks("Akt.xlsm")
.Save
.Close
End With

Next Zelle

Wo du die anderen Informationen herholst, kann ich aus deinen Beispieldateien nicht erkennen. Aber ich glaube das Prinzip wird damit klar.

Gruß

M.O.

Answer 2

Hallo M.O.

das hat mich schon sehr viel weiter gebracht. Dafür vielen Dank.

Das Makro endet aber schein bar nicht, bzw. weiß nicht, wann der letzte Ordner erstellt wurde.



Ich hab dem Makro noch If Dir$ vorgestellt, da es sonst den Fehler macht, schon existierende Ornder zu überarbeiten..

If Dir$(cstPfad & strAktivitäten) = vbNullString Then _

'Datei öffnen
Workbooks.Open (strAktivitäten & "\Akt.xlsm")
'Daten kopieren
Workbooks("Akt.xlsm").Worksheets("Tabelle1").Cells(1, 2) = .Cells(Zelle.Row, 3)
Workbooks("Akt.xlsm").Worksheets("Tabelle1").Cells(3, 2) = .Cells(Zelle.Row, 4) & " " & .Cells(Zelle.Row, 5)

'Akte.xlsm speichern und schließen
With Workbooks("Akt.xlsm")
.Save
.Close

End With


End If

Next Zelle



Danke.

VG Florian

Answer 3

Hallo Florian,

die Datei kann natürlich erst geöffnet werden, wenn das Makro die Verzeichnisse angelegt und die Datei Akte.xlsm kopiert hat.
Von deinem ursprünglichen Makro ausgehend sollte das so aussehen:

Public Sub OrdnerAnlegen()

Const cstPfad As String = "\\S-file01\\Compu-Tests\CRM\"

Dim strKundenOrdner As String, strBasisOrdner As String
Dim strAktivitäten As String, strSchriftverkehr
Dim Zelle As Range

With ActiveSheet

strKundenOrdner = .Range("B1")

If Dir$(cstPfad & strKundenOrdner, vbDirectory) = vbNullString Then _
MkDir cstPfad & strKundenOrdner

For Each Zelle In .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))

If Dir$(cstPfad & strKundenOrdner & "\" & Zelle, vbDirectory) = vbNullString Then

strBasisOrdner = cstPfad & strKundenOrdner & "\" & Zelle
strAktivitäten = strBasisOrdner & "\Aktivitäten"
strSchriftverkehr = strBasisOrdner & "\Schriftverkehr"

MkDir strBasisOrdner
MkDir strAktivitäten
MkDir strSchriftverkehr


FileCopy "\\S-file01\Compu-Tests\CRM\Inhalt\Akt.xlsm", strAktivitäten & "\Akt.xlsm"

.Hyperlinks.Add Anchor:=Zelle.Offset(0, 1), Address:= _
strAktivitäten & "\Akt.xlsm"

'Datei öffnen
Workbooks.Open (strAktivitäten & "\Akt.xlsm")
'Daten kopieren
Workbooks("Akt.xlsm").Worksheets("Tabelle1").Cells(1, 2) = .Cells(Zelle.Row, 2)
Workbooks("Akt.xlsm").Worksheets("Tabelle1").Cells(3, 2) = .Cells(Zelle.Row, 3) & " " & .Cells(Zelle.Row, 4)

'Akte.xlsm speichern und schließen
With Workbooks("Akt.xlsm")
.Save
.Close
End With

End If
Next Zelle
End With

End Sub

Gruß

M.O.

Answer 4

Hallo,

nochmal ich :-). Oder sollen die Daten erst später übernommen werden? Das obige Makro kopiert die Daten nämlich beim Anlegen des Pfades in die Datei Akt.xlsm.

Gruß

M.O.

Answer 5

Hallo M.O.

perfekt.

Vielen Dank. Damit hast du mir wirklich extremst weitergeholfen.

VG Florian

Answer 6

Hallo Florian,

gern geschehen.

Viele Grüße

M.O.