Hyperlink/ Makrolöschung
25.10.2013 12:36:50
Sebastian
ich hoffe, Ihr könnt mir wieder einmal mehr mit einem Problem helfen?!
Ein Makro führt folgende Prozedur aus:
----------
Problem 1
Modul1:
1. Das Vorlage-Dokument wird automatisch gespeichert (fester Pfad wird vorgegeben; Datei wird unter Indexerhöhung gespeichert)
2. Die gespeicherte Datei wird anschließend als Email versendet.
Nun würde ich gerne nur den Dateipfad (Hyperlink) versenden.
----------
Problem 2
Modul2:
Das Modul2 ist nach Ausführen von Modul1 in der gespeicherten Datei nicht mehr verfügbar.
Wie kann ich das ändern, dass das Modul2 in der gepeicherten Datei noch verfügbar ist?
Sub Email_senden()
Dim Speicher_Name As String
Dim Subject As String
Dim Zähler As Integer
MsgBox ("Das Dokument wird jetzt automatisch versandt!")
Speicher_Name = "C:\Documents and Settings\Sebastian.Burmann\My Documents\Dokumente\" & "Ä _
nderung" & ".xls"
While Dir(Speicher_Name) ""
Zähler = Zähler + 1
Speicher_Name = "C:\Documents and Settings\Sebastian.Burmann\My Documents\Dokumente\" & _
"Änderung" & "_" & "S" & Format(Zähler, "0000") & ".xls"
Wend
Sheets("Tabelle1").Copy 'Kopieren in neues Workbook
ActiveWorkbook.ActiveSheet.Range("Y3").Value = "S" & Format(Zähler, "0000")
Subject = "Änderung" & "_" & "S" & Format(Zähler, "0000") & "_" & Date
Application.DisplayAlerts = False
With ActiveWorkbook
.ActiveSheet.Shapes("Grafik 7").Delete 'Entfernt die Grafik 7 (Email-Button)
.ActiveSheet.Shapes("Textfeld 3").Delete 'Entfernt die Textfeld 3 (Emailtext)
'Nachfolgender Code für Excel >2003
'.SaveAs Filename:=Speicher_Name, FileFormat:=xlExcel8, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
.SaveAs Speicher_Name 'Speichern der Kopie mit Tabelle1
.Close
End With
'Ab hier Email-Prozedur
Dim obNachricht As Object
Dim obMail As Object
Dim htmlBody As String
Dim Emailadressen As String
Set obMail = CreateObject("Outlook.Application")
Set obNachricht = obMail.CreateItem(0)
With obNachricht
.GetInspector
.to = "ABC@abc.com"
.CC = "efg@efg.com"
.Subject = Subject
.htmlBody = "Sehr geehrte Damen und Herren," & vbCrLf _
& vbCrLf _
& "anbei erhalten Sie.... " & vbCrLf _
& vbCrLf _
& vbCrLf _
& "" & vbCrLf _
& "" & .htmlBody
.Attachments.Add Speicher_Name
.ReadReceiptRequested = False 'Gelesen-Bestätigung anfordern
.Display 'Email vor dem Senden öffnen
End With
Set obNachricht = Nothing
Set obMail = Nothing
Application.DisplayAlerts = True
MsgBox ("Das Dokument wurde versandt und wird bearbeitet!" & Chr(13) & "Datei wird _
geschlossen ohne zu speichern!" & Chr(13) & "Vielen Dank!")
ActiveWindow.Close saveChanges:=False
ActiveWorkbook.Close saveChanges:=False
End Sub
