Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1460to1464
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Per Makro Datei speichern und per Mail senden

Per Makro Datei speichern und per Mail senden
28.11.2015 13:40:02
Christian
Hallo an alle,
ich hoffe ihr könnt mir helfen, bzw. hoffe dass dies überhaupt möglich ist.
Ich suche ein Makro das folgendes macht.
1. Im Ordner D:\Daten\Excel einen neuen Ordener erstellt und diesen nach dem Inhalt von Tabelle 1, Zelle A12 benennt,
2. dorthinein die Datei abspeichert unter dem Namen "BW CZ"
3. im Outlook eine neue E-Mail öffnet, mit dieser Datei im Anhang.
4. einen (noch von mir zu formulierenden) Text als Text in die E-Mail schreibt.
Ist sowas möglich?
Danke für Eure Hilfe
Christian
PS: Bentze Excel und Outlook in der Version 2016, warum steht das hier eigentlich nicht zur Auswahl?

25
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Per Makro Datei speichern und per Mail senden
28.11.2015 13:59:21
mumpel
Hallo!
Stichwort: CreateObject("Outlook.Application")
Gruß, René

AW: Per Makro Datei speichern und per Mail senden
28.11.2015 14:01:45
Christian
Hallo Rene,
danke für den Hinweis, aber hab leider nicht so ganz ohne Hintergedanken geschrieben dass ich kaum VBA Kenntnisse habe, die reichen aus um wenn ein Makro fumnktioniert in den meisten Fälle nachzuvollziehen was da geschieht, aber dieser einzelne Hinweis hilft mir leider nicht weiter.
Gruß und trotzdem danke
Christian

AW: Per Makro Datei speichern und per Mail senden
28.11.2015 14:16:37
Tino
Hallo,
kannst mal testen.
Private Declare Function apiCreateFullPath _
Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long

Sub Save_And_Mail()
Dim sPath$, DateiName$
Dim MyOutApp As Object, MyMessage As Object

On Error GoTo ErrorHandler:

sPath = Tabelle1.Range("A12").Value
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
If Left$(sPath, 1) <> "\" Then sPath = "\" & sPath

sPath = "D:\Daten\Excel" & sPath
If apiCreateFullPath(sPath) <> 1 Then 'Ordner erstellen 
    MsgBox sPath & vbCr & vbCr & "Order konnte nicht erstellt werden!"
    Exit Sub
End If

With ThisWorkbook 'Pfad + Dateiname 
    DateiName = "BW CZ" & Mid(.Name, InStrRev(.Name, "."), Len(.Name))
    sPath = sPath & DateiName
End With

If Dir(sPath, vbNormal) <> "" Then 'schon vorhanden 
    'Was soll gemacht werden 
    If MsgBox(DateiName & vbCr & "Datei bereits vorhanden!" & vbCr & _
            "Soll diese ersetzt werden?", vbQuestion + vbYesNo) = vbYes Then
        Kill sPath: DoEvents 'Datei löschen 
        ThisWorkbook.SaveCopyAs sPath 'Datei erstellen 
    Else
        Exit Sub
    End If
Else
    ThisWorkbook.SaveCopyAs sPath 'Datei erstellen 
End If

If Dir(sPath, vbNormal) = "" Then 'Datei nicht erstellt 
    MsgBox DateiName & vbCr & vbCr & "Datei konnte nicht erstellt werden!"
    Exit Sub
End If

'Mail + Anhang 
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
    .To = "Hier kommt die Adresse rein"
    .Subject = "hier der Betreff"
    .body = "Mein Text"
    .Attachments.Add sPath
    .Display
End With

ErrorHandler:
If Err.Number <> 0 Then 'Fehler 
    MsgBox Err.Description, _
           vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
           "Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub
Gruß Tino

Anzeige
AW: Per Makro Datei speichern und per Mail senden
28.11.2015 14:28:56
Christian
Hallo Tino,
bekomme leider eine Meldung dass der Code irgendwie für 64 Bit Systeme aktualisiert werden müsste.
Aber hab auch so 2 Fragen zu dem Code:
1. was muss ich tun, wenn ich keine Mailadresse vorgeben möchte? die Zeile einfach weglassen?
2. wie kann ich in den vorgegebenen Text Zeilenumbrüche einfügen?
Gruß
Christian

AW: Per Makro Datei speichern und per Mail senden
28.11.2015 14:44:30
Tino
Hallo,
versuchen wir es mit der bedingten Kompilierung!
zu 1.
übergebe im entsprechenden Teil bei With MyMessage einen Leer String
z.Bsp.: .To = ""
oder lass die ganze Zeile weck.
zu 2.
füge im entsprechenden Teil im Text ein Zeilenumbruch vbCr ein
z.Bsp: .body = "Zeile1" & vbCr & "Zeile2"
#If Win64 Then
Private Declare PtrSafe Function apiCreateFullPath Lib "imagehlp.dll" Alias _
  "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long
#Else
Private Declare Function apiCreateFullPath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" _
  (ByVal lpPath As String) As Long
#End If

Sub Save_And_Mail()
Dim sPath$, DateiName$
Dim MyOutApp As Object, MyMessage As Object

sPath = Tabelle1.Range("A12").Value
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
If Left$(sPath, 1) <> "\" Then sPath = "\" & sPath

sPath = "D:\Daten\Excel" & sPath

If apiCreateFullPath(sPath) <> 1 Then
    MsgBox sPath & vbCr & vbCr & "Order konnte nicht erstellt werden!"
    Exit Sub
End If

With ThisWorkbook
    DateiName = "BW CZ" & Mid(.Name, InStrRev(.Name, "."), Len(.Name))
    sPath = sPath & DateiName
End With

If Dir(sPath, vbNormal) <> "" Then
    If MsgBox(DateiName & vbCr & "Datei bereits vorhanden!" & vbCr & _
            "Soll diese ersetz werden?", vbQuestion) = vbYes Then
        
        ThisWorkbook.SaveCopyAs sPath
    Else
        Exit Sub
    End If
Else
    ThisWorkbook.SaveCopyAs sPath
End If

If Dir(sPath, vbNormal) = "" Then
    MsgBox DateiName & vbCr & vbCr & "Datei konnte nicht erstellt werden!"
    Exit Sub
End If


Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
    .To = "Hier kommt die Adresse rein"
    .Subject = "hier der Betreff"
    .body = "Mein Text"
    .Attachments.Add sPath
    .Display
End With

Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub
Gruß Tino

Anzeige
AW: Per Makro Datei speichern und per Mail senden
28.11.2015 15:00:26
Christian
Hallo Tino,
erstmal vielen Dank. Ich kann nicht klagen, so funktioniert es perfekt.
Aber jetzt doch mal eine ganz blöde Frage, bevor ich das Ganze nochmal in einem Word Forum poste und sich nochmal jemand die ganze Mühe machen muss.
Ich denke ja mal da die ganzen Mechanismen ja dieselben sein werden, wäre das ein großer Umstand für dich daraus auch noch ein Makro zu machen, mit dem Word etwas anfangen kann?
Also der Pfad dann entsprechend D:\Daten\Word und halt die 12. Zeile aus dem Dokument statt aus Tabelle 1.
Wäre das auch machbar, sofern du Ahnung von Word Makros hast?
Gruß und danke schonmal
Christian
PS: ich weiß Word ist hier fachfremd aber wenn sich schonmal jemand mit dem Thema befasst hat und weiß um was es geht...

Anzeige
Bei Word muss ich passen. sorry oT. (offen)
28.11.2015 15:39:39
Tino

AW: Bei Word muss ich passen. sorry oT. (offen)
28.11.2015 16:25:08
Christian
Hallo,
habe doch nochmal ne kleine Frage, wäre es auch machbar, dass das ganze als PDF gespeichert wird? Man kanns ja zumindest beim Speichern auswählen
Gruß und danke
Christian

als PDF
28.11.2015 16:34:48
Tino
Hallo,
kannst mal so versuchen.
#If Win64 Then
Private Declare PtrSafe Function apiCreateFullPath Lib "imagehlp.dll" Alias _
  "MakeSureDirectoryPathExists" (ByVal lpPath As String) As Long
#Else
Private Declare Function apiCreateFullPath Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" _
  (ByVal lpPath As String) As Long
#End If


Sub Save_And_Mail()
Dim sPath$, DateiName$
Dim MyOutApp As Object, MyMessage As Object
Dim booSave As Boolean

sPath = Tabelle1.Range("A12").Value
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
If Left$(sPath, 1) <> "\" Then sPath = "\" & sPath

sPath = "D:\Daten\Excel" & sPath

If apiCreateFullPath(sPath) <> 1 Then
    MsgBox sPath & vbCr & vbCr & "Order konnte nicht erstellt werden!"
    Exit Sub
End If

With ThisWorkbook
'***** Dateiname evtl. anpassen ****************** 
    DateiName = "BW CZ" & ".pdf"                '* 
'************************************************* 
    sPath = sPath & DateiName
End With

If Dir(sPath, vbNormal) <> "" Then
    If MsgBox(DateiName & vbCr & "Datei bereits vorhanden!" & vbCr & _
            "Soll diese ersetz werden?", vbQuestion) = vbYes Then
       
        booSave = True
    Else
        Exit Sub
    End If
Else
    booSave = True
End If

If booSave Then
    ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        sPath, Quality:=xlQualityStandard, IncludeDocProperties:= _
        False, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If

If Dir(sPath, vbNormal) = "" Then
    MsgBox DateiName & vbCr & vbCr & "Datei konnte nicht erstellt werden!"
    Exit Sub
End If



Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
    .To = "Hier kommt die Adresse rein"
    .Subject = "hier der Betreff"
    .body = "Mein Text"
    .Attachments.Add sPath
    .Display
End With

Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub
Gruß Tino

Anzeige
AW: als PDF
28.11.2015 18:05:20
Christian
Hallo Tino,
ja das funktioniert, danke.
Allerdings mal eine Frage zur Logik des Makros, warum prüfst du ob eine Datei, die in einem gerade erst erstelltem Ordner gespeichert werden soll, bereits vorhanden ist?
Christian

AW: als PDF
28.11.2015 18:52:49
Tino
Hallo,
wenn die Datei bereits vorhanden ist muss diese zuvor gelöscht werden!
Gruß Tino

AW: als PDF
28.11.2015 18:54:32
Christian
ja aber sie kann doch gar nicht vorhanden sein, zumindest nicht in dem Ordner in dem sie gespeichert werden soll, weil es diesen vor dem Ausführen noch nicht gab.

AW: als PDF
28.11.2015 19:17:50
Tino
Hallo,
führe den Code ein zweites mal aus.
Gruß Tino

Anzeige
AW: als PDF
28.11.2015 19:22:36
Christian
ok, ich muss zugeben, soweit habe ich nicht gedacht, aber das wird nicht vorkommen ohne vorher A12 geändert zu haben.

dann ist es ja egal oT.
28.11.2015 19:37:28
Tino

AW: als PDF
29.11.2015 12:05:04
mumpel
Bei PDF-Dateien scheint das egal zu sein, da kommt bei mir keine Fehlermeldung wenn die Datei schon existiert.

AW: als PDF
29.11.2015 13:39:18
Tino
Hallo,
ich dachte auch eher an einen kleinen Schutz vor ungewollter Vernichtung der bereits vorhanden Datei!
Gruß Tino

AW: als PDF
29.11.2015 16:18:07
Christian
selbst wenn hätte ich sie immer noch in der gesendeten E-Mail.
Christian

AW: als PDF
29.11.2015 17:01:21
Tino
Hallo,
wenn es für dich unnötig ist und
wir noch länger die für und wieder diskutieren,
dann lösche halt die Zeilen!
Persönlich möchte ich gefragt werden bevor einfach gelöscht wird!
Gruß Tino

Anzeige
AW: Bei Word muss ich passen. sorry oT. (offen)
28.11.2015 20:02:22
mumpel
Bei Word ist das etwas anders. Vor allem die Parameter bei "ExportAsFixedFormat" sind anders. Aber das kannst Du mit dem Makrorekorder aufzeichnen.

AW: Bei Word muss ich passen. sorry oT. (offen)
28.11.2015 20:09:07
Christian
Hallo Mumpel,
wie soll ich aufzeichnen dass ich eine bestimmte Zeile als Ordnernamen haben möchte?
ist mir gerade etwas schleierhaft.
Gruß
Christian

AW: Bei Word muss ich passen. sorry oT. (offen)
28.11.2015 21:07:01
mumpel
In welcher Zeile und an welcher Stelle stehen Ordnername etc.? Hast Du eine Beispieldatei (die vom Aufbau dem Original entspricht)? Dann erstelle ich Dir mal einen Beispeilcode.

AW: Bei Word muss ich passen. sorry oT. (offen)
28.11.2015 21:23:30
Christian
ja, den habe ich sogar aber ich kann hier keine Word Dateien hochladen.
Konnte leider nurn Sceenshot machen.
Zur Info, die 5 Zeilen von Str. Hnr. bis E-Mail, sowie die Zeile links Name Adresse sind Textfelder alles andere ist normaler Text.
Der Ordner soll nach dem Firmennamen benannt werden. und halt statt in D:\Daten\Excel in D:\Daten\Word erstellt werden, alles andere soll genauso gemacht werden wie mit der Excel Datei.
Gruß und danke
Christian
Userbild

Anzeige
AW: Nachtrag
28.11.2015 21:25:50
Christian
ja, kannst dir die Datei auch von dort nehmen.

201 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige