Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ListBox
BildScreenshot zu ListBox ListBox-Seite mit Beispielarbeitsmappe aufrufen

VBA Suche in Unterordnern und Outlook Anhang


Betrifft: VBA Suche in Unterordnern und Outlook Anhang von: Robert
Geschrieben am: 05.01.2018 15:54:33

Ich benötige wieder ein bisschen Hilfe:

1. Code:

Dieser Code sucht mir in einem Ordner nach einer Datei und fügt sie mir in einer Zelle als _ anklickbares Symbol ein.

Sub aaa()
Dim rng As Range
Const strPfad = "Z:\testordner"
Set rng = Range("A7")
Do While rng <> ""
If Dir(strPfad & rng.Offset(, 6) & ".pdf", vbNormal) = "" Then
MsgBox "Die Datei gibt es nicht!", vbInformation, "Gebe bekannt..."
Else
rng.Offset(, 8).Select
ActiveSheet.OLEObjects.Add(Filename:=strPfad & rng.Offset(, 6) & ".pdf", Link:=False, _
DisplayAsIcon:=True, IconFileName:="T:\PFT\pft.ico", _
IconIndex:=0, IconLabel:="").Select
End If
Set rng = rng.Offset(1)
Loop
End Sub

Die Suche erfolgt nur im angegebenen Ordner, die Unterordner werden nicht duchsucht, wie kann ich das ändern? Außerdem hätte ich gern die gefundene Datei nicht als Objekt in einer Zelle eingefügt, sonder, jetzt zum 2. Code:
Option Explicit

Public Sub TableToMail()
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.to =
.Subject =
.HTMLBody = RangeToHTML(ActiveSheet, ActiveSheet.Range("D2:I7"))
.Display 'nur Anzeigen
' .Send 'direkt senden
End With
Set objMail = Nothing
Set objOutlook = Nothing
End Sub

Private Function RangeToHTML(objSheet As Worksheet, objRange As Range) As String
Dim strFilename As String
strFilename = Environ$("TEMP") & "/" & Format(Now, "dd-mm-yyyy_hh-mm-ss") & ".htm"
ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=strFilename, _
Sheet:=objSheet.Name, _
Source:=objRange.Address, _
HtmlType:=xlHtmlStatic).Publish True
RangeToHTML = CreateObject("Scripting.FileSystemObject"). _
GetFile(strFilename).OpenAsTextStream(1, -2).ReadAll
Kill strFilename
End Function

Mit diesem Code wird aus der Excel-Arbeitsmappe eine E-Mail erstellt.
Aber:
- ich hätte gern den Betreff aus der Excel-Datei gezogen, Zelle B5
- als E-Mailtext wird mir der Bereich "D2:I7" ausgegeben, allerdings soll dieser Bereich variabel sein, der Code soll mich also jedes mal Fragen, welcher Bereich des Arbeitsblattes in der E-Mail stehen soll, geht sicher über Markierung oder!? - Außerdem soll dann noch meine Signatur in die Mail.
- nochmal zurück zum 1.Code: der eventuell gefundene Anhang soll als Anhang der E-Mail angefügt werden

Ich hoffe, mir kann jemand helfen!?

  

Betrifft: Betreff, variable Auswahl und Signatur von: Sheldon
Geschrieben am: 05.01.2018 16:52:51

Hallo Robert,

den Betreff kannst du in der Zeile mit

.Subject =
festlegen. Also zB .Subject = Cells(5,2)

Für Auswahl des Tabellenbereichs teste mal das hier:
Set rngAuswahl = Application.InputBox("Quellbereich festlegen", "Welcher Tabellenbereich soll  _
in die EMail?", , , , , , 8)
.HTMLBody = RangeToHTML(ActiveSheet, rngAuswahl)
Signatur einfügen durch hinzufügen dieser Zeile in den With-Block des objMail (am besten gleich als erstes):
.getinspector
Für den Anhang finde ich gerade keinen Code bei mir.

Gruß
Sheldon


Beiträge aus dem Excel-Forum zum Thema "VBA Suche in Unterordnern und Outlook Anhang"