Datei in einem schon angelegten Ordner speichern

  • #1
E

Elhamplo

Aktives Mitglied
Themenersteller
Dabei seit
21.09.2005
Beiträge
26
Reaktionspunkte
0
Hallo,

Ich mal wieder.

Ich bedanke mich schon mal im voraus dafür das Ihr mir helft.

Und zwar hab ich folgendes Problem.

Ich will eine Datei in ein schon angelegten Ordner speichern. Der Name des Ordners ist eine Kundennummer und die Kundennummer ist auch in der Datei in der Spalte J15. Für einen neuen Kunden wird auch dann vorher ein neuer Ordner wieder angelegt. Ist es möglich das Excel sich die Zelle J15 anschaut und die Nummer mit den Ordner vergleicht und der Ordner mit der entsprechenden Nummer gefunden wird die Datei dann in den Ordner speichert??

Danke

Gruß

Elhamplo
 
  • #2
Hallo Elhamplo,

liegen die Kundenordner alle unter einem Verzeichnis ?

Wie sieht eine solche Kundennummer aus ?

Soll ein neuer Ordner angelegt werden, wenn noch kein Ordner vorhanden ist ?

Gruß Matjes :)
 
  • #3
Hallo,

Die Kundennummer ist eine tausender Nummer z.B. 15681. Der Ordner ist schon vorhanden.

Danke Gruß

Elhamplo
 
  • #4
Hallo Elhamplo,

dann probier mal dieses Makro.

Den Hauptpfad in der Konstanten c_Pfad_Ordner_KNrs mußt du noch anpassen.

Gruß Matjes :)
Code: 
'*****************************************************
Sub Excel_SpeichernInOrdnerRangeJ15()
'***
'*** speichert die aktive Arbeitsmappe unter
'*** c_Pfad_Ordner_KNrs\(Inhalt J15)
'***
  Const c_Pfad_Ordner_KNrs = c:\TestKnr\Kundennummern
  Const c_Range_KNr = J15

  Dim ws As Worksheet, wb As Workbook
  Dim s_Knr As String, x As Long, s As Long, ret As Integer
  Dim s_Pfad As String, s_Filename_Full As String
  
 ->aktive Mappe, aktives Blatt
  Set wb = ActiveWorkbook
  Set ws = ActiveSheet
  
 ->KNr holen, Leerzeichen vorn und hinten ggf. löschen
  s_Knr = Trim(ws.Range(c_Range_KNr).Value)
  
 ->Knr prüfen
  If s_Knr =  Then MsgBox (Kundennummer ist leer.): GoTo AUFRAEUMEN
  For x = 1 To Len(s_Knr)
    s = Mid(s_Knr, x, 1)
    Select Case s
      Case 0 To 9->ok
      Case Else->nok
        MsgBox (Kundennummer-> & s_Knr &-> entspricht nicht dem vorgegebnen Format.)
        GoTo AUFRAEUMEN
    End Select
  Next
  
 ->HauptPfad prüfen
  If Dir(c_Pfad_Ordner_KNrs, vbDirectory) =  Then
    MsgBox (HauptPfad-> & c_Pfad_Ordner_KNrs &-> nicht vorhanden.): GoTo AUFRAEUMEN
  End If
  
 ->Pfad für Kundenordner zusammensetzen
  If Right(c_Pfad_Ordner_KNrs, 1) = \ Then
    s_Pfad = c_Pfad_Ordner_KNrs & s_Knr
  Else
    s_Pfad = c_Pfad_Ordner_KNrs & \ & s_Knr
  End If
  
 ->Pfad Kundenordner prüfen
  If Dir(s_Pfad, vbDirectory) =  Then
    ret = MsgBox( _
            Kundenordner-> & s_Pfad &-> nicht vorhanden. & vbLf & vbLf & _
            Soll der Ordner angelegt werden?, _
            vbQuestion + vbDefaultButton2 + vbYesNo)
    If ret = vbYes Then
     ->Pfad anlegen
      On Error Resume Next
      MkDir s_Pfad
      If Err.Number <> 0 Then
        Err.Clear
        MsgBox (s_Pfad &  konnte nicht erstellt werden.)
        On Error GoTo 0
        GoTo AUFRAEUMEN
      End If
      On Error GoTo 0
    Else
      GoTo AUFRAEUMEN
    End If
  End If

 ->neuen vollen Dateipfad zusammenstellen
  s_Filename_Full = s_Pfad & \ & wb.Name
  
 ->prüfen, ob Datei bereits vorhanden ist
  If Dir(s_Filename_Full, vbNormal) <>  Then
   ->bereits vorhanden, Nachfrage auf überschreiben
    ret = MsgBox( _
            Datei-> & s_Filename_Full &-> bereits vorhanden. & vbLf & vbLf & _
            Soll die Datei überschrieben werden?, _
            vbQuestion + vbDefaultButton2 + vbYesNo)
    If ret = vbNo Then GoTo AUFRAEUMEN
  End If

 ->Datei in Kundenordner speichern (ohne Nachfragen)
  Application.DisplayAlerts = False
  wb.SaveAs FileName:=s_Filename_Full
  Application.DisplayAlerts = True

AUFRAEUMEN:
  Set ws = Nothing: Set wb = Nothing
End Sub
 
  • #5
Hey Matjes,

HAMMER!! Danke für den Code!!! Super ding!!

Jetzt noch eine Frage: Es wird nicht die ganze Datei gespeichert sondern ich kopiere vorher das Tabellenblatt hinaus mit den daten und dann kommt Dein Code ins Spiel. Das Fusnst super!!! Jetzt die Frage: Wie kann ich dann den Namen beim Abspeichern ändern?? Das nicht immer Mappe 1 da steht sondern Kundendaten oder ähnlichens???

Gruß

Elhamplo
 
  • #6
Hallo Elhamplo,

man könnte das Kopieren auch gleich mit einbauen.
Also z.B.
- Quelldatei öffnen
- relevantes Blatt aktivieren
- Makro starten
    - Makro legt neu Arbeitsmappe an
    - Makro kopiert aktuelles Blatt in neu Arbeitsmappe
    - Makro speichert neue Arbeitsmappe wie gehabt
        in ...\Kundennummern\(KNR = Inhalt J15)
        und vergibt dabei gleich den richtigen Namen

Wie ist den der Name der Ausgangsdatei ?
Sind die nach einem Muster vergeben?
Wie soll der Name der neuen Datei lauten/hergeleitet werden ?

Gruß Matjes :)
 
  • #7
Hey Matjes,

Danke für Antwort!!!! :)

Mit dem kopieren, da hab ich das mit der Makroaufzeichnung gelöst. Bis Jetzt fehlt mir nur der Name. Ich hab den Code jetzt schon in mehreren Dateien kopiert. Einmal soll die Datei Kundendaten heißen und den Code hab ich für einen andere Datei auch genommen und dort soll die Datei dann Lieferschein heißen. Ich hab den Code in zwei unterschiedliche Datein gepack. Also läuft schon saugut, bis auf die Namen.

Gruß Elhamplo
 
  • #8
Fein  :D

aber wie soll denn nun die Namensgebung ablaufen ?
Wie soll sich der Name denn zusammensetzen ?

Gruß Matjes :)
 
  • #9
Hey,

ich dachte einfach (ich bin ja auch VBA unwissend), wenn ich den Code im Visual Basic im Tabellenblatt Lieferschein einfüge und mit dem Kopier Code wird das Blatt ja in eine neue Mappe kopiert und soll dann einfach unter dem Namen Lieferschein wie schon gehabt (Dein Code) abgespeichert werden. Wenn ich den Code in die Datei mit den Kundendaten in dem Tabeleblatt Kundendaten einfüge soll das gleiche passiern nur unter dem Namen Kundendaten. So ungefähr dacht ich mir das.

ich danke Dir vielmals für Deine Hilfe!!!!!!!!

Gruß

Elhamplo
 
  • #10
Hallo Elhamplo,

wenn ich das richtig verstehe hast du ein Template (Vorlage), wlches als Vorlage für die Erfassung für Kundendaten und Lieferschein dient. In dieses Template hast Du den Makro kopiert. Dieses Blatt Lieferschein willst Du unter der Kundennummer in

Wenn Du Kundendaten erfaßt hast, willst Du per Makro den Lieferschein in einer extra Mappe in besagtem Verzeichnis->Const c_Pfad_Ordner_KNrs' abspeichern.

Wie soll denn der Name der Datei lautetn ?

z.B. Lieferschein_KNR_15862_20051101.xls

Gruß Matjes :)
 
  • #11
Hey Matjes,

Ich hoffe ich hab das jetzt verstanden. Ja, das ist eine Lieferscheinvorlage. Die Vorlage (nur das Tabellenblatt) wird ausgefüllt und mit einem Makro in eine neue Arbeitsmappe kopiert und mit Deinem Makro in den vorhandenen Ordner gespeichert.

Es reicht wenn die neue Datei dann einfach Lieferschein heißt, denn die datei wird ja dank Deinem Makro in den passenden Ordner gespeichert.

Danke

Gruß

Elhamplo
 
  • #12
Hallo Elhamplo,

dann probier mal dieses Makro.

Das Makro sollte in einem Modul in der Lieferscheinvorlage liegen

a) Lieferscheinvorlage öffnen
b) mit Alt+F11 den VB-Editor öffnen
c) im Projektfenster VBAProject(Dateiname) selektieren
d) rechte Maustaste -> Einfügen -> Modul
e) in das sich öffnenende Modulfenster den Makro per Copy&Paste einfügen
f) mit String+S speichern
g) mit Alt+Q VB-Editor schliessen

Ausprobieren:
- Lieferschein ausfüllen
- Makro Excel_LieferscheinSpeichernInOrdnerRangeJ15 ausführen

Gruß Matjes :)
Code: 
Option Explicit
'*****************************************************
Sub Excel_LieferscheinSpeichernInOrdnerRangeJ15()
'***
'*** Das aktive Blatt wird in eine neu Arbeitsmappe gespeichert
'*** Zielordner ist c_Pfad_Ordner_KNrs\(Inhalt J15)
'*** Dateiname: Lieferschein_KNR(Inhalt J15)_yyyymmdd_hhnn.xls
'*** (yyyymmdd_hhnn = aktuelles Datum, z.B. 20051101_1253.xls)

  Const c_Pfad_KNrs = D:\Test\Test_LieferscheinSpeichernInOrdnerJ15\Kundennummern
  Const c_Range_KNr = J15

  Dim ws As Worksheet, wb As Workbook
  Dim wst As Worksheet, wbt As Workbook
  Dim s_Knr As String, x As Long, s As Long, ret As Integer
  Dim s_Pfad As String, s_Filename_Full As String
  
 ->aktive Mappe, aktives Blatt
  Set wb = ActiveWorkbook
  Set ws = ActiveSheet
  
 ->KNr holen, Leerzeichen vorn und hinten ggf. löschen
  s_Knr = Trim(ws.Range(c_Range_KNr).Value)
  
 ->Knr prüfen
  If s_Knr =  Then MsgBox (Kundennummer ist leer.): GoTo AUFRAEUMEN
  For x = 1 To Len(s_Knr)
    s = Mid(s_Knr, x, 1)
    Select Case s
      Case 0 To 9->ok
      Case Else->nok
        MsgBox (Kundennummer-> & s_Knr &-> entspricht nicht dem vorgegebnen Format.)
        GoTo AUFRAEUMEN
    End Select
  Next
  
 ->HauptPfad prüfen
  If Dir(c_Pfad_KNrs, vbDirectory) =  Then
    MsgBox (HauptPfad-> & c_Pfad_KNrs &-> nicht vorhanden.): GoTo AUFRAEUMEN
  End If
  
 ->Pfad für Kundenordner zusammensetzen
  If Right(c_Pfad_KNrs, 1) = \ Then
    s_Pfad = c_Pfad_KNrs & s_Knr
  Else
    s_Pfad = c_Pfad_KNrs & \ & s_Knr
  End If
  
 ->Pfad Kundenordner prüfen
  If Dir(s_Pfad, vbDirectory) =  Then
    ret = MsgBox( _
            Kundenordner-> & s_Pfad &-> nicht vorhanden. & vbLf & vbLf & _
            Soll der Ordner angelegt werden?, _
            vbQuestion + vbDefaultButton2 + vbYesNo)
    If ret = vbYes Then
     ->Pfad anlegen
      On Error Resume Next
      MkDir s_Pfad
      If Err.Number <> 0 Then
        Err.Clear
        MsgBox (s_Pfad &  konnte nicht erstellt werden.)
        On Error GoTo 0
        GoTo AUFRAEUMEN
      End If
      On Error GoTo 0
    Else
      GoTo AUFRAEUMEN
    End If
  End If

 ->neuen vollen Dateinamen zusammenstellen
  s_Filename_Full = s_Pfad & \Lieferschein_KNR & s_Knr & _ & _
                    Format(Now(), yyyymmdd_hhnn) & xls
  
 ->prüfen, ob Datei bereits vorhanden ist
  If Dir(s_Filename_Full, vbNormal) <>  Then
   ->bereits vorhanden, Nachfrage auf überschreiben
    ret = MsgBox( _
            Datei-> & s_Filename_Full &-> bereits vorhanden. & vbLf & vbLf & _
            Soll die Datei überschrieben werden?, _
            vbQuestion + vbDefaultButton2 + vbYesNo)
    If ret = vbNo Then GoTo AUFRAEUMEN
  End If

 ->*** neue Mappe anlegen
  Set wbt = Workbooks.Add
  
 ->überflüssige Blätter löschen, bis auf 1.tes
  Application.DisplayAlerts = False
  For x = wbt.Worksheets.Count To 2 Step -1
    wbt.Worksheets(x).Delete
  Next
  Set wst = wbt.Worksheets(1)
 ->Lieferscheinblatt in neu Mappe kopieren
  ws.Copy After:=wst
 ->- letztes überflüssiges Blatt löschen
  wst.Delete
 ->- Datei in Kundenordner speichern (ohne Nachfragen)
  wbt.SaveAs Filename:=s_Filename_Full
 ->- Datei schliessen
  wbt.Close Savechanges:=False
  Application.DisplayAlerts = True

AUFRAEUMEN:
  Set ws = Nothing: Set wb = Nothing: Set wst = Nothing: Set wbt = Nothing
End Sub
 
  • #13
Hey Matjes,

DANKE!!!!!! Sau ........ Code!!!! Vielen Dank!!!!

Hab den Code ausprobiert und muss sagen funst super!!!

Vielen Dank nochmal für Deine Mühe!!!!!!!

Gruß

Elhamplo
 
Thema:

Datei in einem schon angelegten Ordner speichern

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums

Themen
113.840
Beiträge
707.963
Mitglieder
51.494
Neuestes Mitglied
Flensburg45
Oben