danielra
Goto Top

Excel Tabellenblatt als .csv speichern und mailen

Servus,

ich habe eine Frage.
Ich würde gerne eine Datei die ich in Excel mittels VBA als .csv speichere anschließend direkt in einer Mail verschicken.

Der Code für das Speichern als .csv sieht wie folgt aus:


Private Sub CommandButton2_Click()

Dim speichername As String
Dim Ort As String
Dim Strasse As String
Dim Hausnummer As String
Dim Stiege As String
Dim Tuer As String
Dim ok As Integer

ok = 0

Ort = Worksheets("Eingabe_Laufzettel").Range("B9").Value  
Strasse = Worksheets("Eingabe_Laufzettel").Range("D11").Value  
Hausnummer = Worksheets("Eingabe_Laufzettel").Range("B13").Value  
Stiege = Worksheets("Eingabe_Laufzettel").Range("E13").Value  
Tuer = Worksheets("Eingabe_Laufzettel").Range("H13").Value  

If Hausnummer = "" Then  
Hausnummer = "N"  
End If

If Stiege = "" Then  
Stiege = "N"  
End If

If Tuer = "" Then  
Tuer = "N"  
End If

speichername = "Laufzettel_"  
speichername = speichername + Ort
speichername = speichername + "_"  

speichername = speichername + Strasse
speichername = speichername + "_"  
speichername = speichername + Hausnummer
speichername = speichername + "_"  
speichername = speichername + Stiege
speichername = speichername + "_"  
speichername = speichername + Tuer
speichername = speichername + ".csv"  


fileSaveName = Application.GetSaveAsFilename(speichername, _
    fileFilter:="CSV (Trennzeichen-getrennt) (*.csv), *.csv")  
If fileSaveName <> False Then
    MsgBox "Save as " & fileSaveName  



F = FreeFile(0)
fname = fileSaveName
fseparator = ";"  
If fname <> False Then
Open fname For Output As #F
Cells.Select

Set Rng = ActiveCell.CurrentRegion
Debug.Print Rng.Address
FCol = Rng.Columns(1).Column
LCol = Rng.Columns(11).Column
Frow = Rng.Rows(1).Row
Lrow = Rng.Rows(84).Row

For i = Frow To Lrow
outputLine = ""  
For j = FCol To LCol
If j <> LCol Then
outputLine = outputLine & Cells(i, j) & fseparator
Else
outputLine = outputLine & Cells(i, j)
End If
Next j
Print #F, outputLine
Next i
Close #F
End If

Range("A1").Select  


MsgBox "Vorgang abgeschlossen!"  

End If



End Sub

Anschließend soll aber eben am Ende noch ebenjene Tabelle die hier gespeichert wird als Mail-Anhang angezeigt werden.
Ich habe hier einen Ansazt - bekomme diesen aber nicht kombiniert:

    On Error GoTo ErrHandler
    
    ' SET Outlook APPLICATION OBJECT.  
    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")  
    
    ' CREATE EMAIL OBJECT.  
    Dim objEmail As Object
    Set objEmail = objOutlook.CreateItem(olMailItem)

    With objEmail
        .to = "test@test.at"  
        .Subject = "LZ"  
        .Body = "LZ"  
        .Display
       .Attachments.Add "C:\Users\daniel\Desktop\Regieschein26_v8.xlsm\"  
        
        
'        .Send  
    End With
    
    ' CLEAR.  
    Set objEmail = Nothing:    Set objOutlook = Nothing
    
ErrHandler:

End Sub


Vielen lieben Dank im Voraus für eure Hilfe!

Content-Key: 8180205624

Url: https://administrator.de/contentid/8180205624

Printed on: July 19, 2024 at 10:07 o'clock

Member: Cleanairs
Solution Cleanairs Aug 18, 2023 at 07:34:47 (UTC)
Goto Top
Moin.

Der neue Code enthält zwei Makros, die heißen CommandButton1_Click und CommandButton2_Click. Das Makro CommandButton1_Click speichert die Datei als CSV-Datei und sendet sie dann als Anhang an eine E-Mail. Das Makro CommandButton2_Click ist identisch mit dem Makro aus dem ursprünglichen Code.

Private Sub CommandButton2_Click()

Dim speichername As String
Dim Ort As String
Dim Strasse As String
Dim Hausnummer As String
Dim Stiege As String
Dim Tuer As String
Dim ok As Integer

ok = 0

Ort = Worksheets("Eingabe_Laufzettel").Range("B9").Value    
Strasse = Worksheets("Eingabe_Laufzettel").Range("D11").Value    
Hausnummer = Worksheets("Eingabe_Laufzettel").Range("B13").Value    
Stiege = Worksheets("Eingabe_Laufzettel").Range("E13").Value    
Tuer = Worksheets("Eingabe_Laufzettel").Range("H13").Value    

If Hausnummer = "" Then    
Hausnummer = "N"    
End If

If Stiege = "" Then    
Stiege = "N"    
End If

If Tuer = "" Then    
Tuer = "N"    
End If

speichername = "Laufzettel_"    
speichername = speichername + Ort
speichername = speichername + "_"    

speichername = speichername + Strasse
speichername = speichername + "_"    
speichername = speichername + Hausnummer
speichername = speichername + "_"    
speichername = speichername + Stiege
speichername = speichername + "_"    
speichername = speichername + Tuer
speichername = speichername + ".csv"    


fileSaveName = Application.GetSaveAsFilename(speichername, _
    fileFilter:="CSV (Trennzeichen-getrennt) (*.csv), *.csv")    
If fileSaveName <> False Then
    MsgBox "Save as " & fileSaveName    



F = FreeFile(0)
fname = fileSaveName
fseparator = ";"    
If fname <> False Then
Open fname For Output As #F
Cells.Select

Set Rng = ActiveCell.CurrentRegion
Debug.Print Rng.Address
FCol = Rng.Columns(1).Column
LCol = Rng.Columns(11).Column
Frow = Rng.Rows(1).Row
Lrow = Rng.Rows(84).Row

For i = Frow To Lrow
outputLine = ""    
For j = FCol To LCol
If j <> LCol Then
outputLine = outputLine & Cells(i, j) & fseparator
Else
outputLine = outputLine & Cells(i, j)
End If
Next j
Print #F, outputLine
Next i
Close #F
End If

Range("A1").Select    


MsgBox "Vorgang abgeschlossen!"    
End If



End Sub

Private Sub CommandButton1_Click()

' SET Outlook APPLICATION OBJECT.    
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")    

' CREATE EMAIL OBJECT.    
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)

With objEmail
    .to = "test@test.at"    
    .Subject = "LZ"    
    .Body = "LZ"    
    .Display
    .Attachments.Add speichername
    .Send  
End With

' CLEAR.    
Set objEmail = Nothing:    Set objOutlook = Nothing

End Sub

Um den Code zu verwenden, speichere ihn in einer neuen Excel-Arbeitsmappe und ändere den Wert der Variablen speichername in den Namen der CSV-Datei, die du speichern möchtest. Anschließend klicke auf die Schaltfläche "CommandButton1", um die CSV-Datei zu speichern und als Anhang an eine E-Mail zu senden.
Member: danielra
Solution danielra Aug 18, 2023 at 09:05:14 (UTC)
Goto Top
Wow vielen lieben Dank!!!!!
Ich musste bei .Attachements.Add fileSaveName einfügen aber ansonsten funktioniert es nun wie gewünscht! Danke!
Member: Cleanairs
Cleanairs Aug 18, 2023 at 09:16:35 (UTC)
Goto Top
Super. Dann markier das noch als Lösung. Danke face-smile