Excel-Probleme nach Makro-Ausführung
28.10.2014 12:59:31
Cedric
Ich hoffe, dass mir hier jemand helfen kann, Google ist schon ratlos....
Folgendes Problem: Für eine berufliche Leistungserfassung habe ich ein ziemlich komplexes Excelsheet programmiert, das von vielen Leuten genutzt wird.
An sich stellt euch das wie mehrere Counter vor, die mit Buttons betätigt werden.
Immer mal wieder wird die gesamte Datei mit einer CDO-Mail gesichert. (Backup) Grundsätzlich klappt auch alles, aber:
Das Versenden dieser Mails dauert natürlich ein paar Sekunden. Erfahrungen zeigen, dass, wenn in dieser Zeit einer der Counterbuttons betätigt wird, dies zwar geht, aber zu folgendem Fehler im nachhinein führt:
(- CDO-Backup wird teilweise nicht zu ende geführt sondern hängt sich mit Fehler auf.)
- Aktualisierung des Blattes hängt, sozusagen friert die Anzeige ein. Beispielsweise kann man eine Zelle anklicken und was reinschreiben, wenn man klickt passiert aber gar nichts und auch der Inhalt wird nicht geschrieben. Wechselt man jetzt die Tabelle und geht wieder zurück auf das erste Blatt, steht der Inhalt aber da.
Mit anderen Worten ist Excel dann kaum mehr benutzbar, denn auch die Buttons "bewegen" sich nicht beim draufklicken, im Hintergrund zählts aber.
Nun wollte ich, um Probleme zu vermeiden, das Backup-Makro in eine Userform integrieren und die Modal im Vordergrund lassen... Nur tritt jetzt das oben beschriebene Problem auf, sobald man probiert was anderes als die Userform anzuklicken während das Backup läuft...
Hier das Makro, ohne Daten natürlich...
Sub MultiMail(tyP As Integer, betrefF As String, texT As String)
Dim tag As String
Dim monat As String
Dim jahr As String
Dim stunde As String
Dim minue As String
Dim filename As String
Dim User As String
Dim wiehEis As String
Dim wb(1 To 10) As Integer
Dim ced(1 To 10) As String
Dim iwo(1 To 10) As String
'Constanten
Dim SMTP_Server
Dim SMTP_Port
Dim SMTP_Authenticate
Dim SMTP_FromName
Dim SMTP_FromEMail
SMTP_Server = "####.######.de"
SMTP_Port = 25
SMTP_Authenticate = 0
SMTP_FromName = "Fehler"
SMTP_FromEMail = "fehler@#####.de"
tag = Day(Date)
monat = Month(Date)
jahr = Year(Date)
stunde = Hour(Time)
minue = minute(Time)
User = Sheets("Start").Cells(6, 9)
wiehEis = Sheets("Start").Cells(10, 9)
wb(1) = 1
wb(2) = 1
wb(3) = 0
wb(4) = 1
wb(5) = 1
wb(6) = 0
wb(7) = 0
wb(8) = 0
wb(9) = 0
wb(10) = 0
ced(1) = "#@api.prowlapp.com"
ced(2) = "#@api.prowlapp.com, #@googlemail.com"
ced(3) = ""
ced(4) = "#@api.prowlapp.com"
ced(5) = "#@api.prowlapp.com"
ced(6) = "#@api.prowlapp.com"
ced(7) = "#@api.prowlapp.com"
ced(8) = "#@api.prowlapp.com"
ced(9) = "#@api.prowlapp.com"
ced(10) = ""
iwo(1) = "#@api.prowlapp.com"
iwo(2) = "#@api.prowlapp.com"
iwo(3) = ""
iwo(4) = "#@api.prowlapp.com"
iwo(5) = "#@api.prowlapp.com"
iwo(6) = "#@api.prowlapp.com"
iwo(7) = "#@api.prowlapp.com"
iwo(8) = "#@api.prowlapp.com"
iwo(9) = "#@api.prowlapp.com"
iwo(10) = ""
'Formatieren
tag = Format(tag, "00")
monat = Format(monat, "00")
stunde = Format(stunde, "00")
minue = Format(minue, "00")
'Dateiname
filename = jahr & "_" & monat & "_" & tag & "_-_" & stunde & "_" & minue & "_-_" & User & ". _
xlsm"
'Absender
If User "" Then
SMTP_FromName = User
SMTP_FromEMail = User & "-" & wiehEis & "@######.de"
End If
'text
If wb(tyP) = 1 Then
texT = texT & Chr(13) & ThisWorkbook.FullName
End If
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & filename
Dim mail_To As String
Dim mail_CC As String
Dim mail_BCC As String
Dim mail_Subject As String
Dim mail_Body As String
Dim mail_Attachment As String
'Mailparameter
mail_To = "#########@gmail.com"
mail_CC = ""
mail_BCC = ced(tyP) & ", " & iwo(tyP)
mail_Subject = betrefF
mail_Body = texT
mail_Attachment = ThisWorkbook.Path & "\" & filename
'Senden
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim strfrom As String
Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_Server
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTP_Port
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = SMTP_Authenticate
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
.Update
End With
strbody = mail_Body
If SMTP_FromName = "" Then
strfrom = SMTP_FromEMail
Else
strfrom = Chr(34) & SMTP_FromName & Chr(34) & " "
End If
On Error GoTo err
With iMsg
Set .Configuration = iConf
.To = mail_To
.CC = mail_CC
.BCC = mail_BCC
.From = strfrom
.Subject = mail_Subject
.TextBody = mail_Body
If mail_Attachment "" And Dir(mail_Attachment) "" Then
.AddAttachment mail_Attachment
End If
.Send
End With
Kill ThisWorkbook.Path & "\" & filename
Exit Sub
err:
Dim worbo As Worksheet
Dim lastrow As Long
Set worbo = ThisWorkbook.Sheets("Hinweise")
lastrow = worbo.Cells(Rows.Count, 1).End(xlUp).Row + 1
worbo.Cells(lastrow, 1) = Now()
worbo.Cells(lastrow, 2) = "Fehler beim Backup, Typ:" & tyP & " " & err.number & " " & err. _
Description
Sheets("Auswertung").Cells(41, 16) = Sheets("Auswertung").Cells(41, 16) + 1
End Sub