Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1360to1364
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

mehrere Dateien mit Blättern prüfen + Mail senden

mehrere Dateien mit Blättern prüfen + Mail senden
14.05.2014 09:40:40
Schuh
Hallo!
Brauche dringend Hilfe in VB Excel Programmierung.
Bin grad ziemlich verzweifelt und habe mich hierfür extra gemeldet.
Google brachte leider auch keinen Erfolg.
Bin leider totaler VBA Anfänger und habe keine Ahnung wie ich das in drei Tagen hinkriegen soll.
Folgende Aufgabe:
Ich möchte zwei Verzeichnisse, deren Inhalt Excel Dateien sind, auswählen.
Jedes Verzeichnis besteht aus ca 20 Excel Dateien.
Alle Dateien haben mehrere Arbeitsblätter Jan bis Dez ("Jänner" bis "Dezember")
Die wichtigen Daten befinden sich in jedem Arbeitsblatt in der gleichen Zeile zwischen C35 und AI35.
Es soll nun ein Makro gestaltet werden, das jede Datei in beiden Verzeichnissen aufruft und jedes Arbeitsblatt (Jan bis Dez, zwischen C35 und AI35) von allen Dateien überprüft ob dort der Wert höher als 10,5 ist.
Dies ist die Arbeitszeit in Stunden und kann somit öfters vorkommen.
Wenn der Wert höher ist, sollte in dem Excel-sheet von dem das Makro gestartet wird, der jeweilige Dateiname und die Arbeitsblatt- + Zellenbezeichnung (wo der Wert höher als 10,5 ist) aufgelistet werden.
Im Optimalfall sollte dann ein automatisches E-mail mit Outlook versendet werden können.
Hoffe irgendjemand da draußen hat genug Programmiererfahrung um mir zu Helfen.
Steh nämlich grad ziemlich auf der Leitung. ;(
Besten Dank!

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: mehrere Dateien mit Blättern prüfen + Mail senden
14.05.2014 11:29:06
Rudi
Hallo,
teste mal:
Sub aaaa()
Dim sVerz(1) As String, sFile As String
Dim wksAkt As Worksheet
Dim wks As Worksheet, wkb As Workbook, rng As Range
Dim i As Integer
Const Zeit As Double = 10.5
Set wksAkt = ActiveWorkbook.Sheets(1)
Application.ScreenUpdating = False
For i = 0 To 1
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Ordner auswählen"
If .Show = -1 Then
sVerz(i) = .SelectedItems(1)
End If
End With
If sVerz(i)  "" Then
sVerz(i) = sVerz(i) & "\"
sFile = Dir(sVerz(i) & "*.xls*")
Do While sFile  ""
Set wkb = Workbooks.Open(sVerz(i) & sFile)
For Each wks In wkb.Worksheets
For Each rng In wks.Range("C35:AI35")
If IsNumeric(rng) Then
If rng > Zeit Then
With wksAkt
With .Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0) = wkb.FullName
.Offset(1, 1) = wks.Name
.Offset(1, 2) = rng.Address
.Offset(1, 3) = rng
End With
End With
End If
End If
Next rng
Next wks
wkb.Close False
sFile = Dir
Loop
End If
Next i
End Sub

Gruß
Rudi

Anzeige
AW: mehrere Dateien mit Blättern prüfen + Mail senden
14.05.2014 13:30:08
Schuh
Hi Rudi,
zuerst mal ein riesiges Dankeschön für deine Hilfe.
Der Code funktioniert einwandfrei!
Habe jetz noch zwei/drei kleine Anforderungen an dich, die du im Gegensatz zu mir wahrscheinlich auch in ein paar Minuten lösen kannst:
Anbei ein Beispiel wie diese Dateien aussehen.
Userbild
1)
es super/sinnvoller, wenn im Ausgabesheet anstatt der Zellenname der Tabname mit dem entsprechenden Wert aus Zeile 24 (Tag des Monats) und Überstunden angezeigt wird.
Zb: Zelle C35 = 11
Die Ausgabe im Makro-Excel Sheet soll nun "0,5 Stunden am 1.April" sein.
2)
Da eine automatische Mailversendung mit Outlook stattfinden soll, wäre es von Vorteil die Pfade im Code vorzudefinieren.
3)
Zum Mail: Ich nehm an ich kann diesen Code verwenden oder? Aber wo baue ich ihn dann in deinem Code ein?
Sub Mail()
Dim ObjOutlook As Object
Dim Antwortmail As Object
Set ObjOutlook = CreateObject("Outlook.Application.10")
Set Antwortmail = ObjOutlook.CreateItem(0)
With Antwortmail
.Subject = "Text"
.To = "irgend@was.de"
.Body = "text"
.display
'.Send
End With
End Sub
Danke dir!

Anzeige
AW: mehrere Dateien mit Blättern prüfen + Mail senden
15.05.2014 08:24:14
Schuh
Hi,
habe nochmal versucht den Code zu überabeiten.
jedenfalls bin ich draufgekommen, dass ich einen Pfad: C:\Users\atp00679\Desktop\Ordner\ habe, der 10 Unterordner enthält, wo die Excel sheets drin sind. Komme nun nicht drauf, wie man alle Unterordner durchsuchen und die Excel Dateien auswerten kann.
...\Ordner\Unterordner A\ExcelA.xls
...\Ordner\Unterordner B\ExcelB.xls
...\Ordner\Unterordner C\ExcelC.xls
das automatische Mail-Versenden hab ich auch hinbekommen, zu mindest das Outlook Aufpoppen. Leider muss ich auch hier noch immer manuell auf "senden" klicken..
vl hast du ja noch eine Hilfestellung für mich. (Siehe vorige Antwort)
anbei noch mein Versuch, einen Code umzushcreiben:
Sub aaaa()
Dim sVerz As String, sFile As String
Dim wksAkt As Worksheet
Dim wks As Worksheet, wkb As Workbook, rng As Range
Dim i As Integer
Const Zeit As Double = 10.5
Dim sHauptverzeichnis As String
Set wksAkt = ActiveWorkbook.Sheets(1)
Application.ScreenUpdating = False
sHauptverzeichnis = "C:\Users\atp00679\Desktop\Ordner\"
sVerz = Dir(sHauptverzeichnis, vbDirectory)
Do While sVerz  ""
If sVerz  "." And sVerz  ".." And GetAttr(sHauptverzeichnis & sVerz) = vbDirectory Then
'sVerz = sVerz & "\"
sFile = Dir(sHauptverzeichnis & sVerz & "\" & "*.xls*")
Do While sFile  ""
Set wkb = Workbooks.Open(sHauptverzeichnis & sVerz & "\" & sFile)
For Each wks In wkb.Worksheets
For Each rng In wks.Range("C35:AI35")
If IsNumeric(rng) Then
If rng > Zeit Then
With wksAkt
With .Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0) = wkb.Name
.Offset(1, 1) = wks.Name
.Offset(1, 2) = rng.Cells.Offset(-10, 0).Value
.Offset(1, 3) = rng
End With
End With
End If
End If
Next rng
Next wks
wkb.Close False
sFile = Dir
Loop
End If
sVerz = Dir
Loop
Call EmailTest
End Sub
Sub EmailTest()
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.To = "test@gmx.at"
.Subject = "Test"
.htmlBody = "Test"
.Attachments.Add "C:\Users\atp00679\Desktop\Excel.xlsm"
.Display
End With
End Sub

Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige