Excel file werkt niet op elke computer goed

Status
Niet open voor verdere reacties.
C

corvdh

Gebruiker
Lid geworden
29 aug 2010
Berichten
128
Ik heb een Excel file gemaakt die we op het werk gebruiken op 3 computers.
De file staat op het netwerk en we kunnen deze op elke computer openen.
Nu bevat de file een macro (zie onder) die een door de gebruiker gemaakte cel selectie als nieuw bestand per outlook naar diverse personen verstuurt.

Nu komt het rare, de Excel file werkt wel op mijn computer maar niet op de andere 2 computers.
Daar gaat de macro na de cel selectie en op Ok klikken gelijk naar de Error_handler.
Op alle computers staat Windows 7 en office 2010.

Als de Excelfile wel op mijn computer werkt maar niet op de andere 2 dan is de Excel file toch in orde zou je zeggen en ligt het aan de 2 andere computers.
Kan iemand mij uitleggen wat er fout gaat?

Code: 
Sub email_verzenden_met_celselectie_als_bijlage_FORUM()
    
   
   
   
1        Dim lngAntwoord As Long
2   lngAntwoord = MsgBox("Wil je een e-mail sturen met als bijlage een Exelbestand" + vbCr + "met daarin een door jou gemaakte celselectie?" + vbCr + vbCr + "Klik op Ja om de celselectie te maken die je wilt e-mailen." + vbCr + vbCr + "De volgende adressen zullen deze test mail ontvangen:" + vbCr + vbCr + " 1) Adres 1" + vbCr + " 2) Adres 2" + vbCr + " 3) Adres 3" + vbCr + " 4) Adres 4", vbQuestion + vbYesNo + vbDefaultButton2, "Celselectie e-mailen als bijlage >>>> TEST <<<<")
    If lngAntwoord = vbYes Then
    GoTo 3
    Else
    GoTo Error_handler:
    End If
   
3    Range("A2:N2").Select
     Dim xFile As String
     Dim xFormat As Long
     Dim Wb As Workbook
     Dim Wb2 As Workbook
     Dim Ws As Worksheet
     Dim FilePath As String
     Dim FileName As String
     Dim OutlookApp As Object
     Dim OutlookMail As Object
     Dim WorkRng As Range
     
           
5     xTitleId = "Selecteer de cellen die je wilt mailen          "
      On Error GoTo Error_handler:
     Set WorkRng = Application.Selection
8    Set WorkRng = Application.InputBox("Ctrl toets indrukken en celbereik selecteren, klik daarna op OK.          ", xTitleId, WorkRng.Address, Type:=8)
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
     Set Wb = Application.ActiveWorkbook
     Wb.Worksheets.Add
     Set Ws = Application.ActiveSheet
     WorkRng.Copy Ws.Cells(1, 1)
     Ws.Copy
     Set Wb2 = Application.ActiveWorkbook
     Select Case Wb.FileFormat
     Case xlOpenXMLWorkbook:
     xFile = ".xlsx"
     xFormat = xlOpenXMLWorkbook
     Case xlOpenXMLWorkbookMacroEnabled:
     If Wb2.HasVBProject Then
     xFile = ".xlsm"
     xFormat = xlOpenXMLWorkbookMacroEnabled
     Else
     xFile = ".xlsx"
     xFormat = xlOpenXMLWorkbook
     End If
     Case Excel8:
     xFile = ".xls"
     xFormat = Excel8
     Case xlExcel12:
     xFile = ".xlsb"
     xFormat = xlExcel12
     End Select
     FilePath = Environ$("temp") & "\"
     FileName = Wb.Name & Format(Now, " dd-mmm-yyyy h uur mm s")
     Set OutlookApp = CreateObject("Outlook.Application")
     Set OutlookMail = OutlookApp.CreateItem(0)
     
     ActiveSheet.Unprotect Password:=""
     
     'Nieuw gemaakt Excel bestand instellingen, zie onder
     Columns("A").ColumnWidth = 13.43
     Columns("B").ColumnWidth = 5.14
     Columns("C").ColumnWidth = 12.14
     Columns("D").ColumnWidth = 9.43
     Columns("E").ColumnWidth = 15
     Columns("F").ColumnWidth = 7.86
     Columns("G").ColumnWidth = 7.86
     Columns("H").ColumnWidth = 7.86
     Columns("I").ColumnWidth = 7.86
     Columns("J").ColumnWidth = 7.86
     Columns("K").ColumnWidth = 7.86
     Columns("L").ColumnWidth = 7.86
     Columns("M").ColumnWidth = 7.86
     Columns("N").ColumnWidth = 61.43
     Columns("O").ColumnWidth = 12.14
     Columns("P").ColumnWidth = 12.14
     Columns("Q").ColumnWidth = 19.86
     Rows(1).RowHeight = 55.5
     'ActiveSheet.Name = "Gascylinder administration" 'Naam van het werkblad word zoals hier aangegeven.
     ActiveSheet.Name = Range("A2").Value 'Waarde uit cel A2 van het gemailde bestand word de werkbladnaam
     
   Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintSheetEnd
        .PrintQuality = 300
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
     
     
        Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Select
     
     
     
     Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
     With OutlookMail
     .To = "" 'Typ een mail adres in om deze macro te kunnen testen
     .CC = "" 'Typ een mail adres in om deze macro te kunnen testen
     .BCC = "" 'Typ een mail adres in om deze macro te kunnen testen
     .Subject = "TEST MAIL"
     .Body = "DIT IS EEN TEST MAIL (zie bijlage)"
     .Attachments.Add Wb2.FullName
     .Send 'Verzend de mail direct
     '.Display 'Opent de mail in outlook voor deze word verzonden, klik in outlook op verzenden om de mail daadwerkelijk te versturen.
     End With
     Wb2.Close
     Kill FilePath & FileName & xFile
     Set OutlookMail = Nothing
     Set OutlookApp = Nothing
     Ws.Delete
     Application.DisplayAlerts = True
     Application.ScreenUpdating = True
     
     
9    MsgBox "De e-mail is verzonden en alle wijzigingen" + vbCr + "zijn voor de zekerheid opgeslagen.", vbInformation, "Ter informatie"
     ActiveWorkbook.Save
     GoTo 10
Error_handler: MsgBox "De e-mail is niet verzonden." + vbCr + vbCr + "Indien het hier gaat om een onbekende fout," + vbCr + "raadpleeg cor voor meer informatie.", vbExclamation, "Geannuleerd of onbekende fout opgetreden"

     
   
10   Range("P1").Select
     ActiveSheet.Protect Password:=""
   
    End Sub
 
Als je die error_handler er uit haalt, dan kan je zien waar hij op vastloopt.
 
Ik heb die error_handler er uit gehaalt en de volgende regel in de macro werd als fout aangegeven:
Code: 
Application.PrintCommunication = True
Dit veranderd naar:
Code: 
Application.PrintCommunication = False
En alles lijkt weer te werken.

Bedankt voor de tip, ik was zelf niet op het idee gekomen om die Error_handler eruit te halen.
 
Volgens mij kan je er nog wel een beetje meer uithalen dan de error_handler. Die zou ik in het hele breiwerk juist laten staan.;)

Code: 
Sub email_verzenden_met_celselectie_als_bijlage_FORUM()
Dim c00 As String
  If MsgBox("Wil je een e-mail sturen met als bijlage een Exelbestand" + vbCr + "met daarin een door jou gemaakte celselectie?" + vbCr + vbCr + "Klik op Ja om de celselectie te maken die je wilt e-mailen." + vbCr + vbCr + "De volgende adressen zullen deze test mail ontvangen:" + vbCr + vbCr + " 1) Adres 1" + vbCr + " 2) Adres 2" + vbCr + " 3) Adres 3" + vbCr + " 4) Adres 4", vbQuestion + vbYesNo + vbDefaultButton2, "Celselectie e-mailen als bijlage >>>> TEST <<<<") <> vbYes Then Exit Sub
   
    On Error GoTo Error_handler:
    Application.InputBox("Ctrl toets indrukken en celbereik selecteren, klik daarna op OK.          ", "Selecteer de cellen die je wilt mailen          ", Type:=8).Copy
    With Workbooks.Add
      With .Sheets(1)
        .Paste
        .Columns.AutoFit
        .Rows(1).RowHeight = 55.5
        .Name = .Cells(2, 1)
      End With
      c00 = Environ$("temp") & "\" & ThisWorkbook.Name & Format(Now, " dd-mmm-yyyy h uur mm s") & ".xlsx"
      .SaveAs c00
      
      With CreateObject("Outlook.Application").CreateItem(0)
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "TEST MAIL"
        .Body = "DIT IS EEN TEST MAIL (zie bijlage)"
        .Attachments.Add c00
        .Display 'of .send
      End With
      .Close
      Kill c00
    End With
    ThisWorkbook.Save
    MsgBox "De e-mail is verzonden en alle wijzigingen" + vbCr + "zijn voor de zekerheid opgeslagen.", vbInformation, "Ter informatie"
    Exit Sub
Error_handler:
  MsgBox "De e-mail is niet verzonden." + vbCr + vbCr + "Indien het hier gaat om een onbekende fout," + vbCr + "raadpleeg cor voor meer informatie.", vbExclamation, "Geannuleerd of onbekende fout opgetreden"
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan