Per Makro Datei speichern und per Mail senden

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

Betrifft: Per Makro Datei speichern und per Mail senden
von: Christian
Geschrieben am: 28.11.2015 13:40:02

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?

Bild

Betrifft: AW: Per Makro Datei speichern und per Mail senden
von: mumpel
Geschrieben am: 28.11.2015 13:59:21
Hallo!
Stichwort: CreateObject("Outlook.Application")
Gruß, René

Bild

Betrifft: AW: Per Makro Datei speichern und per Mail senden
von: Christian
Geschrieben am: 28.11.2015 14:01:45
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

Bild

Betrifft: AW: Per Makro Datei speichern und per Mail senden
von: Tino
Geschrieben am: 28.11.2015 14:16:37
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

Bild

Betrifft: AW: Per Makro Datei speichern und per Mail senden
von: Christian
Geschrieben am: 28.11.2015 14:28:56
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

Bild

Betrifft: AW: Per Makro Datei speichern und per Mail senden
von: Tino
Geschrieben am: 28.11.2015 14:44:30
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

Bild

Betrifft: AW: Per Makro Datei speichern und per Mail senden
von: Christian
Geschrieben am: 28.11.2015 15:00:26
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...

Bild

Betrifft: Bei Word muss ich passen. sorry oT. (offen)
von: Tino
Geschrieben am: 28.11.2015 15:39:39


Bild

Betrifft: AW: Bei Word muss ich passen. sorry oT. (offen)
von: Christian
Geschrieben am: 28.11.2015 16:25:08
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

Bild

Betrifft: als PDF
von: Tino
Geschrieben am: 28.11.2015 16:34:48
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

Bild

Betrifft: AW: als PDF
von: Christian
Geschrieben am: 28.11.2015 18:05:20
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

Bild

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

Bild

Betrifft: AW: als PDF
von: Christian
Geschrieben am: 28.11.2015 18:54:32
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.

Bild

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

Bild

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

Bild

Betrifft: dann ist es ja egal oT.
von: Tino
Geschrieben am: 28.11.2015 19:37:28


Bild

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

Bild

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

Bild

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

Bild

Betrifft: AW: als PDF
von: Tino
Geschrieben am: 29.11.2015 17:01:21
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

Bild

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

Bild

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

Bild

Betrifft: AW: Bei Word muss ich passen. sorry oT. (offen)
von: mumpel
Geschrieben am: 28.11.2015 21:07:01
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.

Bild

Betrifft: AW: Bei Word muss ich passen. sorry oT. (offen)
von: Christian
Geschrieben am: 28.11.2015 21:23:30
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

Bild

Betrifft: Nachtrag
von: mumpel
Geschrieben am: 28.11.2015 21:12:48
Bist Du das? => Makro das neuen Ordner erstellt und Dokument darin speichert

Bild

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

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Per Makro Datei speichern und per Mail senden"