Hallo,
Zou iemand willen meekijken naar mijn bestand?
Het is van mijn werk en gemaakt door iemand in Excel 2003 maar helaas krijgen we nu (overgang naar Office 2010) steeds foutmeldingen.
Het bestand splitst het hoofdbestand en zet daarna de bestanden in de mail in Outlook.
Ik heb divers pogingen gedaan om het te verkleinen naar 100 kb (wat wel heel erg klein is) maar met zip en rar kom ik niet kleiner dan 180 kb.
Ik kan daarom geen voorbeeld meesturen helaas.
Het splitsen gaat goed maar het mailen geeft foutmeldingen, geheel wisselend mailt hij maar 4 bestanden, als je het daarna nog een keer doet misschien wel 16 (van de 32). Maar nooit allemaal.
Foutmeldingen tijdens het overzetten van de bestanden naar outlook:
Run-time error 9
Subscrips out of range
en toen ik het nog een keer deed kreeg ik deze:
Error 1004
Application defined of object defined error
In VBA kreeg ik deze error (geel gemaakt in de gehele vba sheet omdat ik het niet kan meesturen).
Ik heb het hele stukje gevonden op het internet en vervangen en toch blijft de foutmelding.
Wie kan/wil mij helpen?
(ik het bestand ook naar je mailen als dat mag op dit forum)
Groetjes, Marielle
Zou iemand willen meekijken naar mijn bestand?
Het is van mijn werk en gemaakt door iemand in Excel 2003 maar helaas krijgen we nu (overgang naar Office 2010) steeds foutmeldingen.
Het bestand splitst het hoofdbestand en zet daarna de bestanden in de mail in Outlook.
Ik heb divers pogingen gedaan om het te verkleinen naar 100 kb (wat wel heel erg klein is) maar met zip en rar kom ik niet kleiner dan 180 kb.
Ik kan daarom geen voorbeeld meesturen helaas.
Het splitsen gaat goed maar het mailen geeft foutmeldingen, geheel wisselend mailt hij maar 4 bestanden, als je het daarna nog een keer doet misschien wel 16 (van de 32). Maar nooit allemaal.
Foutmeldingen tijdens het overzetten van de bestanden naar outlook:
Run-time error 9
Subscrips out of range
en toen ik het nog een keer deed kreeg ik deze:
Error 1004
Application defined of object defined error
In VBA kreeg ik deze error (geel gemaakt in de gehele vba sheet omdat ik het niet kan meesturen).
Ik heb het hele stukje gevonden op het internet en vervangen en toch blijft de foutmelding.
Wie kan/wil mij helpen?
(ik het bestand ook naar je mailen als dat mag op dit forum)
Groetjes, Marielle
Code:
Sub MailSets()
Dim oCell As Range
'Make sure you change "Sheet1" below,
'so it matches the name of the worksheet with email settings
For Each oCell In Sheets("Email").UsedRange.Columns(1).Cells
If oCell.Row > 1 Then
'Skip first row; contains header
If Not IsEmpty(oCell.Value) Then
Mail_Selection Sheets(oCell.Value).Range(oCell.Offset(, 2).Value), oCell.Offset(, 1).Value
End If
End If
Next
End Sub
Code:
Sub Mail_Selection(Source As Range, sTo As String)
'Working in 2000-2010
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, " & _
"please correct and try again.", vbOKOnly
Exit Sub
End If
If ActiveWindow.SelectedSheets.Count > 1 Or _
Source.Cells.Count = 1 Or _
Source.Areas.Count > 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You have more than one sheet selected" & vbNewLine & _
"or you only selected one cell" & vbNewLine & _
"or you selected more than one area." & vbNewLine & vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteAll
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = " ziekenlijst "
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2010
FileExtStr = ".xls": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = sTo
.CC = ""
.BCC = ""
.Subject = "ziekenlijst"
.BodyFormat = olFormatHTML
.HTMLBody = "<p></p><br>" & _
"<p><font size='2' face='Arial'>Beste collega's,</font></p><br>" & _
"<hr />" & _
"<p><font size='2' face='Arial'>In de bijlage vind je de ziekenlijst van afgelopen week.</font></p><br>" & _
"<p><font size='2' face='Arial'>In deze lijst zijn alle ziek- en betermeldingen verwerkt ***.</font></p><br>" & _
"<p><font size='2' face='Arial'>Wanneer er sprake is van ***.</font></B></p><br>" & _
"<hr />" & _
"<p><font size='2' face='Arial'>Met vriendelijke groet,</font></p><br>" & _
"<font size='2' face='Arial'>***</font></p><br>" & _
"<p></p>" & _
"<p></p>" & _
"<p></p>" & _
"<font color='grey' size='1' face='Arial'>Deze e-mail is automatisch gegenereerd. Reacties kunt u sturen naar ***.</font><br>" & _
"<font color='grey' size='1' face='Arial'>Mail to: [email]***[/email] "
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Laatst bewerkt door een moderator:
