Foutmelding

[poom]

Goede middag,

Bij het automatisch verzenden van een WorkSheet krijg ik ondanks het feit dat het
sheet wel wordt verzonden steeds de volgende foutmelding via Windows Live Mail:

"Er zijn fouten opgetreden bij het verwerken van de gevraagde taken"

De opdracht wordt gegeven via de volgende code:

Sub antoine()

    Application.ScreenUpdating = False
    
 Dim MijnBlad As Worksheet
    For Each MijnBlad In Worksheets
    MijnBlad.Select
    MijnBlad.Unprotect "zacharias"
 Next MijnBlad

    'Working in Excel 2000-2013
    Dim FileExtStr As String
    Dim FileFormatNum As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Determine the Excel version and file extension/format
    If Val(Application.Version) >= 12 Then
        'You run Excel 2007-2013
        FileExtStr = ".xlsm": FileFormatNum = 52
    Else
        'You run Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    End If

    Sheets("Formulier").Select
    Sheets("Formulier").Range("A1:O31").Select
    Selection.Copy
    Sheets("Anton").Select
    
    Sheets("Anton").Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        
    Sheets("Anton").Range("A1").Select
    
    Sheets("Formulier").Select
    
    Sheets("Formulier").Range("A1").Select

     ChDir "C:\Wilhelminahuis 1\Temp"
    Workbooks.Open Filename:= _
        "C:\Wilhelminahuis 1\WedstrFWilhelminahuis1_.xls"
    Sheets("Blad1").Select
    Sheets("Blad1").Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("Blad1").Range("A1").Select
    Application.CutCopyMode = False
   
'Retrieve file name to use for Save
    filesavename = Application.GetSaveAsFilename( _
    fileFilter:="Excel Files (*.xls), *.xls")

'If user specified file name, perform Save and display msgbox
    If filesavename <> False Then
        ActiveWorkbook.SaveAs Filename:=filesavename, FileFormat:=xlNormal

        MsgBox "Save As " & filesavename
    End If
    
        Dim strDate As String
        
    ActiveWorkbook.SendMail "anla@zeelandnet.nl", _
                            "WedstrijdFormulier Wilhelminahuis 1"
    ActiveWorkbook.ChangeFileAccess xlReadOnly
    
 '   MsgBox "Formulier verzonden naar Anton", vbOKOnly
    
    ActiveWorkbook.Close False
    
    Application.ScreenUpdating = True
    
    Sheets("Start").Select
    Sheets("Start").Range("A1").Select
      
        For Each MijnBlad In Worksheets
    MijnBlad.Select
    MijnBlad.Protect "zacharias", True, True, True
    
Next MijnBlad

    Sheets("Start").Select
    Sheets("Start").Range("A1").Select

 With Application
   .ScreenUpdating = True
   .EnableEvents = True
End With

End Sub

Weet iemand waar de fout zit?

Bij voorbaat dank voor uw hulp!


groten, Piet.

 

[edmoor]

Het is Windows Live Mail die de melding geeft. Wat het verzenden van de mail betreft is je code in orde. Je kan dit proberen:

    On Error Resume Next
    ActiveWorkbook.SendMail "anla@zeelandnet.nl", _
                            "WedstrijdFormulier Wilhelminahuis 1"
    On Error GoTo 0

Maar als de melding van WIndows Live Mail komt zal je het daarin moeten zoeken.

 

[poom]

edmoor,

Je advies geprobeerd, maar de melding blijft komen.
Zal proberen het in Windows Live Mail op te lossen.
In ieder geval bedankt voor je medewerking!

Piet.