Dateien suchen und kopieren

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Dateien suchen und kopieren
von: Bernd M.
Geschrieben am: 07.03.2005 12:47:50
Hallo Kollegen,
ich bitte um eure Hilfe bei meinem kleinen Problem.
Ich möchte gern (aus Excel heraus) Dateien aus einem lokalen Verzeichnis per Email versenden. Die Dateinamen sollen vom aktiven Tabellenblatt aus Spalte A
ausgelesen werden. Hier stehen die Dateinamen in Form von Auftragsnummern
z.B. 6400
6433
7430
....usw
Die dazugehörigen Datein stehen im Pfad C:\Daten_Email
6400.cs
6433.dwg
7430.dxf
....usw
Eine Datei anhand 1 Zelle (zB. A2) zu suchen und per Email zu versenden funktioniert auch schon. Aber wie erreiche ich, dass der komplette Bereich mit allen vorhandenen Einträgen (nur Spalte A, Anzahl Zellen variabel zwischen 1 bis 15) gesucht und gesendet wird? Schön wäre auch ein MsgBox ob alle Dateien gefunden wurden.
Vorhandener Code:


Sub EmailverschickenmitAnhang()
Dim outObj As Object
Dim Mail As Object
Dim i As Integer
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
With Mail
    .Subject = "Aufträge"
    .Body = "Im Anhang neue Aufträge"
    .To = "emailadresse@t-online.de"
End With
    With Application.FileSearch
        .NewSearch
        .LookIn = "C:\Daten_email\"
        .SearchSubFolders = True
        .Filename = Range("A2") & ".*"
        .Execute
        For i = 1 To .FoundFiles.Count
            Mail.Attachments.Add .FoundFiles(i)
        Next i
    End With
    Mail.Display
    Set Mail = Nothing
    Set ouobj = Nothing
End Sub

Ich hoffe Ihr könnt helfen.
Gruß Bernd
Bild

Betrifft: AW: Dateien suchen und kopieren
von: Rolf Beißner
Geschrieben am: 09.03.2005 16:29:23
Hallo Bernd,
versuch mal das (ungetestet)
fG
Rolf

Sub EmailverschickenmitAnhang()
Dim outObj As Object
Dim Mail As Object
Dim i As Integer
Dim bereich as Range, feld as Range
Set outObj = CreateObject("Outlook.Application")
Set bereich = Range("A1:A15")
For Each feld in bereich
If feld <> "" Then
Set Mail = outObj.CreateItem(0)
With Mail
    .Subject = "Aufträge"
    .Body = "Im Anhang neue Aufträge"
    .To = "emailadresse@t-online.de"
End With
    With Application.FileSearch
        .NewSearch
        .LookIn = "C:\Daten_email\"
        .SearchSubFolders = True
        .Filename = feld.value & ".*"
        .Execute
        For i = 1 To .FoundFiles.Count
            Mail.Attachments.Add .FoundFiles(i)
        Next i
    End With
    Mail.Display
    Set Mail = Nothing
End If
Next
    Set ouobj = Nothing
End Sub

Bild

Betrifft: AW: Dateien suchen und kopieren
von: Bernd
Geschrieben am: 10.03.2005 09:42:51
Hallo Rolf,
erst einmal Danke für deine Antwort.
Leider erzeugt der Code aber ein Fehler beim kompilieren. "FOR ohne NEXT"
er erwartet wohl eine NEXT-Anweisung.
Mit schleifen kenne ich mich nicht gut aus.
Muss die Variable 'feld' nicht noch definiert werden und zudem vom
Typ Variant sein?
Vielleicht noch ne Idee?
Gruß Bernd
Bild

Betrifft: AW: Dateien suchen und kopieren
von: Rolf Beißner
Geschrieben am: 10.03.2005 12:16:11
Hallo Bernd,
bei mir läuft's einwandfrei.
Möglicherweise lag's an einem Schreibfehler
in deiner vorletzten Zeile.
FG
Rolf
PS
Bitte Rückmeldung

Sub EmailverschickenmitAnhang()
    Dim outObj As Object
    Dim Mail As Object
    Dim i As Integer
    Dim bereich As Range, feld As Range
    
    Set outObj = CreateObject("Outlook.Application")
    
    Set bereich = Range("A1:A15")
    
    For Each feld In bereich
    
        If feld <> "" Then
            Set Mail = outObj.CreateItem(0)
            
            With Mail
                .Subject = "Aufträge"
                .Body = "Im Anhang neue Aufträge"
                .To = "xxx"
            End With
            
            With Application.FileSearch
                .NewSearch
                .LookIn = "xxx"
                .SearchSubFolders = True
                .Filename = feld.Value & ".*"
                .Execute
                For i = 1 To .FoundFiles.Count
                    Mail.Attachments.Add .FoundFiles(i)
                Next i
            End With
            
            Mail.Display
            Set Mail = Nothing
            
        End If
    Next
    Set outObj = Nothing
End Sub

Bild

Betrifft: AW: Dateien suchen und kopieren
von: Bernd
Geschrieben am: 10.03.2005 16:16:38
Hallo Rolf,
du hast so recht, wer lesen kann ist klar im Vorteil ;-)
Jetzt funktioniert es. (musste es allerdings noch etwas umstellen, da er sonst für
jede Zelle mit Daten eine eigene email erstellt)
Suuper ich Danke dir Rolf

Bernd
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Dateien suchen und kopieren"