Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro einmal pro Worksheet ausführen

Makro einmal pro Worksheet ausführen
12.03.2021 11:53:46
Ingo
Hallo weltbeste Excel Spezialiste,
ich habe mal wieder eine Schreibblockade.
In einem Workbook habe ich 36 verschidene Worksheets.
Jedes enthält einen Header, ein paar Daten und eine Mailadresse.
Jedes Worksheet soll jetzt an die jeweilige Maiadresse geschickt werden.
Dafür habe ich ein praktisches Makro. Leider kann ich das immer nur für ein Worksheet aktivieren.
Könnt ihr mir dabei helfen dieses Makro in einen Loop zu bringen, der jedes einzelne Worksheet als outlook mail verschickt?
Mein Makro sieht so aus:
Sub SendWorkSheet()
'The Monthly Areaplanner Overview per country
Dim xFile As String
Dim xFormat As Long
Dim Wb As Workbook
Dim Wb2 As Workbook
Dim FilePath As String
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim Dates As Variant
Dim Mail As Variant
Mail = Range("k2").Text
Dates = Range("B3").Text
On Error Resume Next
Application.ScreenUpdating = False
Set Wb = Application.ActiveWorkbook
ActiveSheet.Copy
Set Wb2 = Application.ActiveWorkbook
Select Case Wb.FileFormat
Case xlOpenXMLWorkbook:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Case xlOpenXMLWorkbookMacroEnabled:
If Wb2.HasVBProject Then
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Else
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If
Case Excel8:
xFile = ".xls"
xFormat = Excel8
Case xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
End Select
FilePath = Environ$("temp") & "\"
FileName = Wb.Name & Format(Now, "dd-mmm-yy h-mm-ss")
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
With OutlookMail
.To = Mail
.CC = ""
.BCC = ""
.Subject = "Monthly Country AreaPlan Overview"
.Body = "Dear AreaPlanner Approver," & vbCrLf & _
" " & vbCrLf & _
"here you are with the 'AreaPlan Monthly Overview' of your country." & vbCrLf & _
"The Overview shows how many SVCs are covered by an actual AreaPlan by the date of " _
& Dates & "." & vbCrLf & _
"Thanks a lot." & vbCrLf & _
" " & vbCrLf & _
"With Kind Regards" & vbCrLf & _
"Your EU-NOEP Team"
.Attachments.Add Wb2.FullName
.Send
End With
Wb2.Close
Kill FilePath & FileName & xFile
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Application.ScreenUpdating = True
End Sub
Im Voraus vielen DAnk
Ingo

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro einmal pro Worksheet ausführen
12.03.2021 12:04:28
ralf_b
Hallo Ingo,
wenn das dein Makro wäre, dann ist so ein "Loop" locker selbst hinzubekommen.
Ich habe den Eindruck du läßt dir dein Projekt häppchenweise für lau zusammenbasteln.
Deine eigene Vorleistung fehlt.
gruß
rb

AW: Makro einmal pro Worksheet ausführen
12.03.2021 12:24:45
Ingo
Hallo Ralf_b,
das ist korrekt beobachtet. Nein, das Makro ist in Hauptauszügen nicht von mir.
Es besteht aus frei verfügbaren Teilen, die ich auf meinen Bedarf zugeschnitten habe. So kann ich den Umgang mit VBA lernen. Und Nein, ich kriege das Loopen nicht hin. Deswegen der Beitrag im Forum.
Das Teil, das die Mail aktiviert ist auch nur ein kleines Bestandteil, quasi der Abschluss.
Wie geht dieser Thread jetzt weiter?
Mit freundlichen Grüßen
Ingo

Anzeige
AW: Makro einmal pro Worksheet ausführen
12.03.2021 12:55:53
Klaus
Hallo Ingo,
quick and dirty mit activate:
Sub allSheetsSend()
Dim blatt As Worksheet
For Each blatt In Worksheets
blatt.Activate
Call SendWorkSheet
Next blatt
End Sub
LG,
Klaus M.

ungetestet: Loop eingebaut
12.03.2021 13:01:57
Klaus

Sub SendWorkSheet()
'The Monthly Areaplanner Overview per country
Dim xFile As String
Dim xFormat As Long
Dim Wb As Workbook
Dim Wb2 As Workbook
Dim FilePath As String
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim Dates As Variant
Dim Mail As Variant
On Error Resume Next
Application.ScreenUpdating = False
Set Wb = Application.ActiveWorkbook
Select Case Wb.FileFormat
Case xlOpenXMLWorkbook:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Case xlOpenXMLWorkbookMacroEnabled:
If Wb2.HasVBProject Then
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Else
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If
Case Excel8:
xFile = ".xls"
xFormat = Excel8
Case xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
End Select
Set OutlookApp = CreateObject("Outlook.Application")
Dim Blatt As Worksheet
For Each Blatt In Worksheets
Mail = Blatt.Range("k2").Text
Dates = Blatt.Range("B3").Text
Blatt.Copy
Set Wb2 = Application.ActiveWorkbook
FilePath = Environ$("temp") & "\"
FileName = Wb.Name & Format(Now, "dd-mmm-yy h-mm-ss")
Set OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
With OutlookMail
.To = Mail
.CC = ""
.BCC = ""
.Subject = "Monthly Country AreaPlan Overview"
.Body = "Dear AreaPlanner Approver," & vbCrLf & _
" " & vbCrLf & _
"here you are with the 'AreaPlan Monthly Overview' of your country." &  _
vbCrLf & _
"The Overview shows how many SVCs are covered by an actual AreaPlan by  _
the date of " _
& Dates & "." & vbCrLf & _
"Thanks a lot." & vbCrLf & _
" " & vbCrLf & _
"With Kind Regards" & vbCrLf & _
"Your EU-NOEP Team"
.Attachments.Add Wb2.FullName
.Send
End With
Wb2.Close
Kill FilePath & FileName & xFile
Set OutlookMail = Nothing
Next Blatt
Set OutlookApp = Nothing
Application.ScreenUpdating = True
End Sub
Wie gesagt, nicht getestet. Müsste aber eigentlich gehen. Dass "On Erro Resume Next" eine Todsünde ist, weisst du aber?
LG,
Klaus M.

Anzeige
AW: Makro einmal pro Worksheet ausführen
12.03.2021 13:57:06
Ingo
Hallo Klaus,
das ist chic, kurz und knackig.
Ich habe das dann zwischenzeitlich mit
For i=1 To ActiveWorkbook.Sheets.Count
Und am Schluss der Mail Operation mit
ActiveSheet.Next.Select
hinbekommen. Geht auch. Das musste ich mir dann jetzt mal beweisen, das ich das auch alleine hinkriegen kann.
Deine Lösung habe ich abgespeichert. Sicher werde ich sie noch nutzen können.
Vielen Dank, ich habe wieder dazu gelernt.
Viele Grüße
Ingo

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige