Verkn. Löschen! Geht es denn wirklich nicht! Help!
21.04.2005 12:00:54
DonFiala
habe ein Makro dass ein Tabellenblatt in eine neue Datei kopiert, abspeichert und als Email Anhang versendet.
Leider kommt beim Empfänger immer die Frage nach der Aktualisierung! Egal ob man dann ja oder nein drückt, die Werte werden dann ersetz durch dieses komische Wert#! Zeichen oder so ähnlich und man kann nix mehr erkennen.
Habe ewig hier im Forum gesucht, aber nix funktionierendes gefunden. Entweder die Makros bringen Fehlermeldungen, oder sie bewirken nicht, d.h. bei Bearbeiten Verknüpfung steht immer noch die Verknüpfung zur Ursprungsquelle.
Wer is so super Freundlich und gibt mir ein Makro bzw. ergänz mein Makro damit es funktioniert, krieg langsam echt die Krise! Vielen Vielen Dank
P.S. bin ne absolute VBA Niete :-(
1000end Dank, Gruss michi
Sub emailManuell()
ActiveSheet.Copy
ActiveSheet.Unprotect "Passwort"
' Wartepopup Herber
Dim WsShell, Rück%
Set WsShell = CreateObject("WScript.Shell")
Rück = WsShell.Popup("Datei wird für Speicherung vorbereitet. Bitte einen Augeblick Geduld...", 5 _
, "Überschrift ...")
' Die 5 in der letzten Zeile gibt die Dauer der Öffnung an.
' Rück ist -1 wenn keine Taste gedrückt wurde
' Rück ist 1 wenn OK gedrückt wurde
' Herber Programm, FUNKTIONIERT ABER LEIDER NICHT!!!!!!!!!!!!!!!!!!!!!!!!
Dim Zelle As Range
'erste Verknüpfung finden
Set Zelle = Cells.Find(What:="]", LookIn:=xlFormulas)
If Not Zelle Is Nothing Then
Do
Zelle = Zelle.Value
Set Zelle = Cells.FindNext(Zelle)
Loop While Not Zelle Is Nothing
End If
Dim DName As String, Dateiname As String, Pfad As String
Pfad = Range("Y7")
DName = Range("V6")
Dateiname = Pfad & "\" & DName & Format(Range("G7"), "YYYY.MMM") & ".xls"
' Tagesdatum als "Jahr.Monat.Tag" wegen Exploreransicht!
'ActiveWorkbook.SaveAs Filename:=Dateiname
'ActiveSheet.Select
' ActiveWindow.Close SaveChanges:=0
On Error GoTo Fehler
ArbVerz = CurDir
ChDir Pfad
ChDir ArbVerz
ActiveWorkbook.SaveAs Filename:=Dateiname
MsgBox "Datei wurde erfolgreich unter dem Namen " & ActiveWorkbook.Name & " gespeichert."
'ActiveWorkbook.Close
'Exit Sub
'Makro "senden" aufrufen (call kannste weglassen)
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String
Dim D2Name As String
D2Name = Range("V7")
'Aktive Arbeitsmappe wird als Mail gesendet
AWS = Pfad & "\" & DName & Format(Range("G7"), "YYYY.MMM") & ".xls"
' AWS = ThisWorkbook.FullName
InitializeOutlook = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = D2Name
' .To = "D2Name"
.Subject = "Zielerreichungsgespräch " '& Date
.attachments.Add AWS
'.Body = "Das ist ein Test." & vbCrLf & "Bitte ignorieren."
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'Mail.Send
End With
' OutApp.Quit
Set OutApp = Nothing
Set Nachricht = Nothing
ActiveWorkbook.Close
Exit Sub
Fehler:
If Err.Number = 1004 Then
MsgBox "Datei nicht gespeichert"
Else
MsgBox Err.Description: 'Exit Sub
End If
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
End Sub