Speicherpfad aus Zelle
30.08.2018 16:47:16
Guesa
Bitte nochmals um Unterstützung. Folgender Code funktioniert soweit, allerdings möchte ich gerne das der Speicherpfad aus einer Zelle z.B. A1 ausgelesen wird. Könntet ihr mir diese Zeile entsprechend ändern.
Für Eure Hilfe schon mal ein Danke schön
Gruß, Guesa
Option Explicit
Private Declare
Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal DirPath As String) As Long
Sub Send_Mitgl_sport()
Dim strPATH As String
Dim strFILE As String
Dim olApp As Object
Dim strBody As String, strSubj As String
Dim strTo As String
With ActiveSheet
strPATH = "D:\Freud und Leid\Test\" 'Dies aus Zelle auslesen
MakeSureDirectoryPathExists strPATH
strFILE = strPATH & .Range("A2") & ".pdf"
strTo = .Range("A1") 'Absenderadresse
End With
Dim wksPDF As Worksheet
'Set wksPDF = Worksheets("Info")
Set wksPDF = ActiveSheet
wksPDF.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strFILE, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'erstellt Mailobjekt mit Outlook
strBody = vbLf & "Mit sportlichen Grüßen" _
& vbLf & vbLf & "Gerd Mustermann"
strSubj = "Freud & Leid- Kasse"
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.To = strTo
'.cc
'.bcc
'Wichtigkeit Hoch (1 = normal, 0 = niedrig)
'.importance = 2
.Subject = strSubj
.Body = strBody 'wenn ausgeblendet, wird Standard-Signatur eingefügt
'.BodyFormat = 2 'olFormatHTML
'.ReadReceiptRequested = True 'Lesebestätigung anfordern
.Attachments.Add strFILE
.display
'.send
End With
Set wksPDF = Nothing
Set olApp = Nothing
End Sub