Excel 2003 VBA script mit cellen inhalt

schonen guten tag alle

erst mal mochte ich mich entschuldigen fur meine schreibfehler

ich kan auch keine a,o,u, punkten verwenden

Hallo alle,

ich habe schon einen fertigen Script aber ich mochte den gerne ausbreiten

mochte gerne das er hier: .Body = "Hierbij de Brokerage update van de holdcage" & " " & Format(Now, "dd-mm-yy")
nach holdcage noch den Zellen Inhalt z.b. von scheibt

das ist ein teil von den script:

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = Sourcewb.Name & " "

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Update Actual Holdkooilijst(0.4) Tilburg" & " " & Format(Now, "dd-mm-yy")
.Body = "Hierbij de Brokerage update van de holdcage" & " " & Format(Now, "dd-mm-yy")
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

ich hoffe jemand kam mir hier weiter helfen und schon mal danke schon

gr BOB

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 202019

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

Ausgedruckt am: 17.11.2024 um 07:11 Uhr

1 Kommentar

Hallo Daniel!

In etwa so:

Option Explicit

Const SheetName = "Tabelle1"    'Tabellenname  

Const BegZeile = 5              'Von Zeile 5  
Const EndZeile = 10             'Bis Zeile 10  
Const BegSpalte = 1             'Von Spalte A  
Const EndSpalte = 8             'Bis Spalte H  

Private Sub CreateMail()
    Dim sSubject As String, sText As String, sAttachment As String
    
    sSubject = "Update Actual Holdkooilijst(0.4) Tilburg " & Format(Date, "dd-mm-yy")  
    sText = "Hierbij de Brokerage update van de holdcage " & Format(Date, "dd-mm-yy")  
    sAttachment = Environ("Temp") & "\" & ThisWorkbook.Name  
    
    ThisWorkbook.SaveCopyAs sAttachment
    
    With CreateObject("Outlook.Application").CreateItem(0)  
        .Subject = sSubject
        .To = "Max.Mustermann@test.uk"  
        .cc = "Max.Mustermann@test.uk"  
        .HTMLbody = GetHtmlBodyText(sText)
        .Attachments.Add sAttachment
        .Display    'oder .Send  
    End With

    Kill sAttachment
End Sub

Private Function GetHtmlBodyText(ByRef sText) As String
    Dim sHtmlText As String, c As Long, r As Long
    
    sHtmlText = "<DIV>" & vbCrLf  
    sHtmlText = sHtmlText & sText & vbCrLf
    sHtmlText = sHtmlText & "<TABLE cellSpacing=0 cellPadding=0 width=""100%"" border=1>" & vbCrLf  
    sHtmlText = sHtmlText & "<TBODY>" & vbCrLf  
    
    For r = BegZeile To EndZeile
        sHtmlText = sHtmlText & "<TR>" & vbCrLf  
        For c = BegSpalte To EndSpalte
            sHtmlText = sHtmlText & "<TD>" & Sheets(SheetName).Cells(r, c) & "</TD>" & vbCrLf  
        Next
        sHtmlText = sHtmlText & "</TR>" & vbCrLf  
    Next
    
    sHtmlText = sHtmlText & "</TBODY></TABLE></DIV>" & vbCrLf  
    
    GetHtmlBodyText = sHtmlText
End Function