oceanrace
Gebruiker
- Lid geworden
- 14 mei 2008
- Berichten
- 198
Hallo forummers,
In de volgende code krijg ik een melding waar ik maar niet vanaf kom.
Alles werkt goed, behalve de bijlage mailen:
Dit stukje: .Attachments.Add ActiveWorkbook.FullName
Ik krijg de melding Error 13, typen komen niet overeen.
Iemand een idee?
Dus bij deze regel gaat het mis: .Attachments.Add ActiveWorkbook.FullName
Error 13, typen komen niet overeen.
De mail kan wel zonder bijlage worden verstuurd.
In de volgende code krijg ik een melding waar ik maar niet vanaf kom.
Alles werkt goed, behalve de bijlage mailen:
Dit stukje: .Attachments.Add ActiveWorkbook.FullName
Ik krijg de melding Error 13, typen komen niet overeen.
Code:
Sub Opslaanzonderformules()
Dim Sh As Shape
Dim savedNumber As Long
On Error Resume Next
Dim strFileName As Variant, strPath As String
Dim VBProj As VBIDE.VBProject, VBComp As VBIDE.VBComponent, CodeMod As VBIDE.CodeModule
If Sheets("TK WEV").Range("AG2") = "" Then
MsgBox "Er is geen berekening ingevuld in deze kaart." & vbCrLf & _
"Voer eerst een berekening uit en sla het bestand" & vbCrLf & _
"vervolgens op via de .XLS of .XPS (pdf) button.", vbInformation + vbOKOnly, "Onvoldoende gegevens gevuld"
Exit Sub
Else
If Application.Version = "14.0" Then
MsgBox "Je gebruikt Excel 2010, opslaan via XLS button kan problemen geven." & vbCrLf & _
"Advies: Gebruik de XPS button om op te slaan." & vbCrLf & _
"" & vbCrLf & _
"Dit rekenformulier werkt optimaal in Excel 2003!", vbInformation + vbOKOnly, "Controle Excel versie"
ElseIf Application.Version = "12.0" Then
MsgBox "Je gebruikt Excel 2007, opslaan via XLS button kan problemen geven." & vbCrLf & _
"Advies: Gebruik de XPS button om op te slaan." & vbCrLf & _
"" & vbCrLf & _
"Dit rekenformulier werkt optimaal in Excel 2003!", vbInformation + vbOKOnly, "Controle Excel versie"
End If
strFileName = Application.GetSaveAsFilename(InitialFileName:=strPath & [AG2], _
FileFilter:="Excel 2000 - 2003 Werkblad (*.xls), *.xls", _
FilterIndex:=2, Title:="Opslaan als excel document, zonder formules (sluit wel eerst alle andere bestanden).")
If strFileName = False Then
MsgBox "De rekenkaart is niet opgeslagen!", vbInformation + vbOKOnly, "Opslaan geannuleerd..."
Else
Call ClearClipboard
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayStatusBar = True
Application.Statusbar = "Bezig met opslaan, even geduld a.u.b..."
ActiveSheet.Copy
With ActiveWorkbook
With .Sheets("TK WEV")
.Unprotect "TEST"
.UsedRange.Value = .UsedRange.Value
Union(.Range(.Cells(56, 1), .Cells(.Rows.Count, .Columns.Count)), _
.Range(.Cells(1, 80), .Cells(80, .Columns.Count))).Clear
.Range("BK5").ClearContents
ActiveSheet.Cells.ClearComments
For Each Sh In .Shapes
If Sh.Name <> ("Picture 934") Then Sh.Delete
Next Sh
.Protect "TEST"
End With
Set VBProj = .VBProject
If Err.Number = 1004 Then
MsgBox "Toets 'Ctrl-1' om het originele Excel menu te laten verschijnen." & vbCrLf & _
"" & vbCrLf & _
"Excel 2003:" & vbCrLf & _
"Zet in menu Extra, Macro, Beveiliging: 'Beveiligingsniveau' op laag en" & vbCrLf & _
"vink in 'Vertrouwde uitgevers' toegang tot visual basic project vertrouwen aan!" & vbCrLf & _
"" & vbCrLf & _
"Excel 2007 en 2010:" & vbCrLf & _
"Klik op Office-knop, Opties, Vertrouwenscentrum," & vbCrLf & _
"Instellingen Vertrouwenscentrum, tab Instellingen voor macro’s." & vbCrLf & _
"Vink 'Alle macro’s inschakelen' en 'toegang objectmodel vba project vertrouwen' aan!" & vbCrLf & _
"" & vbCrLf & _
"Toets 'Ctrl-2' om het originele Excel menu weer te laten verdwijnen." & vbCrLf & _
"" & vbCrLf & _
"", vbInformation + vbOKOnly, "Opslaan niet mogelijk: Macrobeveiliging niet goed ingesteld, doorloop de volgende stappen:"
ActiveWorkbook.Close savechanges:=False
Exit Sub
ElseIf Err.Number <> 0 Then
savedNumber = Err.Number
On Error GoTo 0
Error savedNumber
End If
Err.Clear
On Error GoTo 0
For Each VBComp In VBProj.VBComponents
If VBComp.Type = vbext_ct_Document Then
Set CodeMod = VBComp.CodeModule
With CodeMod
.DeleteLines 1, .CountOfLines
End With
Else
VBProj.VBComponents.Remove VBComp
End If
Next VBComp
.SaveAs Filename:=strFileName
Application.Statusbar = "Opgeslagen als " & strFileName
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End With
a = MsgBox("Wil je de rekenkaart printen?" & vbCrLf & _
"De opgeslagen rekenkaart wordt vervolgens" & vbCrLf & _
"afgesloten om terug te gaan naar het origineel. ", vbQuestion + vbYesNo, "Gelukt, de rekenkaart is opgeslagen!")
If a = vbYes Then
Application.Dialogs(xlDialogPrint).Show
End If
On Error Resume Next
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "rekenkaart.test@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "test"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update
End With
strbody = "Er is zojuist een berekening gemaakt door " & [X5] & ", van " & [AG2] & ", " & [A2] & "."
With iMsg
Set .Configuration = iConf
.To = "rekenkaart.test@gmail.com"
.CC = ""
.BCC = ""
' Note: The reply address is not working if you use this Gmail example
' It will use your Gmail address automatic. But you can add this line
' to change the reply address .ReplyTo = "Reply@something.nl"
.From = """rekenformulier test"" <rekenkaart.test@gmail.com>"
.Subject = "" & [A2] & ", " & [AG2] & ", " & [X5] & "."
.TextBody = strbody
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
ActiveWorkbook.Close savechanges:=False
Run "Werkbalken_weg"
Call heropen
Exit Sub
End If
End If
End SubIemand een idee?
Dus bij deze regel gaat het mis: .Attachments.Add ActiveWorkbook.FullName
Error 13, typen komen niet overeen.
De mail kan wel zonder bijlage worden verstuurd.
