Hallo zusammen,
ich habe ein Tabellenblatt, wo ich mit einem Macro einen bestimmten Bereich auswähle und dieser dann per Mail verschickt werden soll.
Erledigte Zeilen blende ich mit einem normalen Filter aus, diese werden mir aber (warum auch immer) in der versendeten Mail dann doch angezeigt.. Weiß jemand wo hier mein Fehler ist? :-/
Danke im Voraus und LG,
Benny
ich habe ein Tabellenblatt, wo ich mit einem Macro einen bestimmten Bereich auswähle und dieser dann per Mail verschickt werden soll.
Erledigte Zeilen blende ich mit einem normalen Filter aus, diese werden mir aber (warum auch immer) in der versendeten Mail dann doch angezeigt.. Weiß jemand wo hier mein Fehler ist? :-/
Visual Basic-Quellcode
- Sub Versand5()
- Dim oOutlookApp As Object, oOutlookMessage As Object
- Dim oFSObj As Object, oFSTextStream As Object
- Dim rngeSend As Range, strHTMLBody As String, strTempFilePath As String, strTempFileFullPath As String
- Dim ColIndex, RowIndex, Var1, Var2, i As Integer
- Dim DatumSheet
- Sheets("Protokoll").Select
- On Error Resume Next
- Set rngeSend = Range("B1:G15", Range("G65536").End(xlUp)).Select
- If rngeSend Is Nothing Then Exit Sub
- On Error GoTo 0
- Set oFSObj = CreateObject("Scripting.FilesystemObject")
- strTempFilePath = oFSObj.GetSpecialFolder(2) & "\"
- strTempFileFullPath = strTempFilePath & "XLRange.htm"
- Dim imgPrefix As String: imgPrefix = "Myimg"
- ActiveWorkbook.PublishObjects.Add(4, strTempFileFullPath, rngeSend.Parent.Name, rngeSend.Address, 0, imgPrefix, "").Publish True
- Set oOutlookApp = CreateObject("Outlook.Application")
- Set oOutlookMessage = oOutlookApp.CreateItem(0)
- For i = 1 To 1
- oOutlookMessage.To = "SMA"
- oOutlookMessage.Subject = "Protokoll vom " & Range("G7")
- Set oFSTextStream = oFSObj.OpenTextFile(strTempFileFullPath, 1)
- strHTMLBody = oFSTextStream.ReadAll
- Dim j As Integer
- Dim strData() As String
- strData() = Split(strHTMLBody, vbCrLf)
- For j = LBound(strData) To UBound(strData)
- If InStr(1, strData(j), "Myimg_", vbTextCompare) And InStr(1, strData(j), ".png", vbTextCompare) Then
- Debug.Print strData(j)
- strData(j) = Replace(strData(j), "XLRange-Dateien/", strTempFilePath & "XLRange-Dateien/")
- Debug.Print strData(j)
- End If
- Next j
- strHTMLBody = Join(strData, vbCrLf)
- oOutlookMessage.HTMLBody = strHTMLBody
- oOutlookMessage.Display
- Cells(1, 1).Select
- Next i
- ActiveWorkbook.Save
- '
- End Sub
-
Danke im Voraus und LG,
Benny