1
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
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
Share on Facebook
Share on Twitter
Share on Reddit
Share on LinkedinPlease also mark the comments that contributed to the solution of the article
Content-Key: 202019
Url: https://administrator.de/contentid/202019
Printed on: April 18, 2024 at 06:04 o'clock
1 Comment
Hallo Daniel!
In etwa so:
Gruß Dieter
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 FunctionGruß Dieter
