AW: Variable Namen automatisch erkennen
24.10.2005 00:32:47
Erich
Hallo nochmal Erich,
warum stiegst du schon aus - so kurz vor dem Ziel? So sollte es geehen:
Sub MehrMails2()
Dim strPath As String, strFile As String
Dim strMitgl(1 To 20) As String, strAnr(20) As String, strEml(20) As String
Dim strsh20 As String
Dim ii As Integer, jj As Integer
strMitgl(1) = "Mayr1": strAnr(1) = "Mayr1"
strEml(1) = "test@t-online.de"
strMitgl(2) = "Mayr2": strAnr(2) = "Willi"
strEml(2) = "test@web.de"
strMitgl(3) = "Mayr3": strAnr(3) = "Anna"
strEml(3) = "test@gmx.de"
strsh20 = "Gesamt K10"
For ii = 1 To 3
Application.ScreenUpdating = False
Sheets(Array(strMitgl(ii), strsh20)).Copy ' 2 Sheets werden ausgewählt
For jj = 1 To Sheets.Count
Sheets(jj).Activate
Call Verknuepfungen_löschen
Next jj
Application.CutCopyMode = False
strPath = "C:\Windows\Temp\"
strFile = strPath & strMitgl(ii) & ".xls"
With ActiveWorkbook
.SaveAs strFile
Senden strFile, strAnr(ii), strEml(ii) ' mit 3 Parametern
.Close
End With
Kill strFile 'Datei löschen
Next ii
Application.ScreenUpdating = True
End Sub
Sub Senden(AWS As String, Anred As String, MailAdr As String)
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = MailAdr & """" ' Muss & """" wirklich da stehen ?
.Subject = "Test1"
.attachments.Add AWS
.Body = "Hallo " & Anred & "," _
& vbCrLf & vbCrLf & "anbei die zwei Sheets." _
& vbCrLf & vbCrLf & "mfg Erich"
.Display
.Send
End With
End Sub
Sub Verknuepfungen_löschen()
' tut was auch immer, dann am Ende:
Range("A1").Select ' dient dazu, dass nicht das ganze Blatt Select
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort