• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Error bij mail verzenden

  • Onderwerp starter Onderwerp starter adile
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.

adile

Gebruiker
Lid geworden
2 mrt 2014
Berichten
202
Goedemiddag,

Ik ben met een macro bezig waarmee ik 2 sheets van mijn bestand kan mailen.
Dit werkt oke, alleen heb ik er 2 vraagjes over die iemand wellicht kan beantwoorden.

Wanneer ik de mail verstuur krijg ik een pop-up zie hieronder afb 1.

Naamloos.jpg

in deze pop-up kan ik op ja, nee of help drukken.

wanneer ik op ja druk opent hij outlook (zoals het hoort)
wanneer ik nee druk krijg ik een error zie afb 2

Naamloos2.jpg

Wanneer ik hier op foutopsporing druk krijg ik een gele balk in mijn code zie afb 3.

Naamloos3.jpg

Ik heb geprobeert "On Error GoTo GetOut" toe te voegen en GetOut onder Kill LWorkbook.FullName te plaatsen, dan komt de error bij Nee niet meer, maar dan opent hij outlook bij Ja ook niet meer. wie o wie heeft de oplossing?

Code:
Sub MailErReport()

   Dim oApp As Object
   Dim oMail As Object
   Dim LWorkbook As Workbook
   Dim LFileName As String
   Set Data = Sheets("Data")
   
   'Turn off screen updating
   Application.ScreenUpdating = False
   
   'Copy the active worksheet and save to a temporary workbook
   Sheets(Array("ER Report", "Afhandeling")).Copy
 Set LWorkbook = ActiveWorkbook
   
   'Create a temporary file in your current directory that uses the name
   ' of the sheet as the filename
   LFileName = "ER Report " & Cells(2, 8) & " " & Cells(22, 21) & ".xls"
   On Error Resume Next
   'Delete the file if it already exists
   Kill LFileName
   On Error GoTo 0
   'Save temporary file
   LWorkbook.SaveAs Filename:=LFileName
   
   'Create an Outlook object and new mail message
   Set oApp = CreateObject("Outlook.Application")
   Set oMail = oApp.CreateItem(0)
   
   'Set mail attributes (uncomment lines to enter attributes)
   ' In this example, only the attachment is being added to the mail message
   

   
   With oMail
      .to = "A@b.nl" 'Data.Cells(2, 42) & Data.Cells(3, 42) & Data.Cells(4, 42) & Data.Cells(5, 42) & Data.Cells(6, 42) & Data.Cells(7, 42) & Data.Cells(8, 42) & Data.Cells(9, 42) & Data.Cells(10, 42) & Data.Cells(11, 42) & Data.Cells(12, 42) & Data.Cells(13, 42)
      .Subject = "ER Report " & Cells(2, 8) & " " & Cells(22, 21)

      .HTMLBody = "<font Face = ""Arial"">" & Data.Cells(1, 24) & "</font><br><br>"

        
        
      .Attachments.Add LWorkbook.FullName
      .Display
   End With
   
   'Delete the temporary file and close temporary Workbook
   LWorkbook.ChangeFileAccess Mode:=xlReadOnly
   Kill LWorkbook.FullName
   LWorkbook.Close savechanges:=False
   
   'Turn back on screen updating
   Application.ScreenUpdating = True
   Set oMail = Nothing
   Set oApp = Nothing
   
End Sub


Adile
 
Probeer eens.
Code:
  LWorkbook.SaveAs LFileName,52
 
Ik krijg de volgende melding. na het aanpassen van de code.

Naamloos4.jpg
 
Laatst bewerkt:
Zet dan eens bovenaan de code:
Code:
application.displayalerts = false
en net boven 'end sub' de zaak weer op 'true'.
 
In onderstaande coderegel zou je toch een schijf moeten toevoegen.
Code:
LFileName = [COLOR=#ff0000]"C:\[/COLOR]ER Report " & Cells(2, 8) & " " & Cells(22, 21) & ".xls"
 
Het zelfde resultaat.
de code is nu dus zo:


Code:
Sub MailErReport()
Application.DisplayAlerts = False
   Dim oApp As Object
   Dim oMail As Object
   Dim LWorkbook As Workbook
   Dim LFileName As String
   Set Data = Sheets("Data")
   
   'Turn off screen updating
   Application.ScreenUpdating = False
   
   'Copy the active worksheet and save to a temporary workbook
   Sheets(Array("ER Report", "Afhandeling")).Copy
 Set LWorkbook = ActiveWorkbook
   
   'Create a temporary file in your current directory that uses the name
   ' of the sheet as the filename
   LFileName = "C:\ER Report " & Cells(2, 8) & " " & Cells(22, 21) & ".xls"
   On Error Resume Next
   'Delete the file if it already exists
   Kill LFileName
   On Error GoTo 0
   'Save temporary file
   LWorkbook.SaveAs Filename, 52
   
   'Create an Outlook object and new mail message
   Set oApp = CreateObject("Outlook.Application")
   Set oMail = oApp.CreateItem(0)
   
   'Set mail attributes (uncomment lines to enter attributes)
   ' In this example, only the attachment is being added to the mail message
   

   
   With oMail
      .to = "A@b.nl" 'Data.Cells(2, 42) & Data.Cells(3, 42) & Data.Cells(4, 42) & Data.Cells(5, 42) & Data.Cells(6, 42) & Data.Cells(7, 42) & Data.Cells(8, 42) & Data.Cells(9, 42) & Data.Cells(10, 42) & Data.Cells(11, 42) & Data.Cells(12, 42) & Data.Cells(13, 42)
      .Subject = "ER Report " & Cells(2, 8) & " " & Cells(22, 21)

      .HTMLBody = "<font Face = ""Arial"">" & Data.Cells(1, 24) & "</font><br><br>" _

        
        
      .Attachments.Add LWorkbook.FullName
      .Display
   End With
   
   'Delete the temporary file and close temporary Workbook
   LWorkbook.ChangeFileAccess Mode:=xlReadOnly
   Kill LWorkbook.FullName
   LWorkbook.Close savechanges:=False
   
   'Turn back on screen updating
   Application.ScreenUpdating = True
   Set oMail = Nothing
   Set oApp = Nothing
   Application.DisplayAlerts = True
End Sub
 
Plaats dan maar het bestand met de code.
Dan zie ik direct de fouten als die zich alsmaar voordoen.

Test het zo eens.
Het rode gedeelte aanpassen.
Code:
Sub MailErReport()
Dim LWorkbook As Workbook
   Dim LFileName 'As String
   Dim data As Worksheet
   Set data = Sheets("Data")
   Application.DisplayAlerts = False
   'Turn off screen updating
   Application.ScreenUpdating = False
   
   'Copy the active worksheet and save to a temporary workbook
   Sheets(Array("ER Report", "Afhandeling")).Copy
    Set LWorkbook = ActiveWorkbook
   
   'Create a temporary file in your current directory that uses the name
   ' of the sheet as the filename
   LFileName = "[COLOR="#FF0000"]C:\users\hsv\desktop\[/COLOR]ER Report" & Cells(2, 8) & "" & Cells(22, 21)
   On Error Resume Next
   'Delete the file if it already exists
   Kill LFileName
   On Error GoTo 0
   'Save temporary file
   LWorkbook.SaveAs LFileName, 51
   

   
   'Set mail attributes (uncomment lines to enter attributes)
   ' In this example, only the attachment is being added to the mail message
   

   
   With CreateObject("Outlook.Application").CreateItem(0)
      '.to = "A@b.nl" 'Data.Cells(2, 42) & Data.Cells(3, 42) & Data.Cells(4, 42) & Data.Cells(5, 42) & Data.Cells(6, 42) & Data.Cells(7, 42) & Data.Cells(8, 42) & Data.Cells(9, 42) & Data.Cells(10, 42) & Data.Cells(11, 42) & Data.Cells(12, 42) & Data.Cells(13, 42)
      .Subject = "ER Report " & Cells(2, 8) & " " & Cells(22, 21)

      .HTMLBody = "<font Face = ""Arial"">" & data.Cells(1, 24) & "</font><br><br>" _

        
        
      .Attachments.Add LWorkbook.FullName
      .Display
   End With
   
   'Delete the temporary file and close temporary Workbook
   LWorkbook.ChangeFileAccess Mode:=xlReadOnly
   Kill LWorkbook.FullName
   LWorkbook.Close 0
   
   'Turn back on screen updating
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub
 
Laatst bewerkt:
HSV,

Dat is hem hij werkt, hij opent nu direct outlook zonder pup-ups.

Hartelijk dank weer voor je hulp.:):thumb:


Gr Adile
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan