Ciao a tutti,

Allora ho un'applicazione che mi legge la posta e in base alla oggetto nella mail mi genere un foglio excel.

Allora se nella mail box ho 2 richieste la prima mi va bene e la seconda va in CRASH non il seguente errore "1004 - Application-defined or object-defined error".


questo è il mio Codice

codice:
Dim oapplicazione As Excel.Application

Function PianoRisorsePersone(mycdc AS STRING) As String
    Dim oCartella As Excel.Workbook
    Dim fso As Scripting.FileSystemObject
    Dim sFileName As String
    Dim flgExcelAperto As Boolean
    Dim errMsg As String
    On Error GoTo errmgr

    Set oapplicazione = New Excel.Application
    Set oCartella = oapplicazione.Workbooks.Add
    Set oFoglio = oCartella.Worksheets("Foglio1")

    errMsg = ""
    

   
    With oCartella
        PreparaColonneExcel
        If Len(Trim(mycdc)) = 0 Then
            subScriviTestataFileExcelPianoRisorse
        Else
            subScriviTestataFileExcelPianoRisorse
        End If
        Set fso = New Scripting.FileSystemObject
        If fso.FileExists("C:\PianoRisorse.xls") Then
            fso.DeleteFile ("C:\PianoRisorse.xls")
        End If
        FileName = "PianoRisorse"
        .SaveAs "C:\" & FileName
    End With
    
    
    oapplicazione.Cells.Select
    oapplicazione.Selection.Font.Size = 8
    oapplicazione.Columns(aCols(FirstCol) & ":" & aCols(LastCol)).EntireColumn.AutoFit
    
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$8:$8"
        .PrintTitleColumns = ""
        
        .Orientation = xlLandscape
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        
    End With
    
    oCartella.Close True
    If oFoglio Is Nothing = False Then Set oFoglio = Nothing
    If oCartella Is Nothing = False Then Set oCartella = Nothing
    oapplicazione.Workbooks.Close
    oapplicazione.Quit
    If oapplicazione Is Nothing = False Then Set oapplicazione = Nothing
    errMsg = ""
    PianoRisorsePersone = errMsg
    Exit Function
errmgr:
    errMsg = Err.Number & " - " & Err.Description
    With oCartella
        Set fso = New Scripting.FileSystemObject
        If fso.FileExists("C:\Err.xls") Then
            fso.DeleteFile ("C:\Err.xls")
        End If
        FileName = "Err"
        .SaveAs "C:\" & FileName
    End With
    oCartella.Close True
    If oFoglio Is Nothing = False Then Set oFoglio = Nothing
    If oCartella Is Nothing = False Then Set oCartella = Nothing
    oapplicazione.Workbooks.Close
    oapplicazione.Quit
    If oapplicazione Is Nothing = False Then Set oapplicazione = Nothing
    PianoRisorsePersone = errMsg

End Function

Sub subScriviTestataFileExcelPianoRisorse()

 myScriviCella 1, 11, "PR10-REP-RISORSE - PIANO DELLE RISORSE ", FontSize:=12, FontStyle:="Grassetto"
 
END SUB

Sub myScriviCella(Riga As Integer, Col As Integer, testo As Variant, _
    Optional FontSize As String, _
    Optional FontStyle As String)
        
    oFoglio.Cells(Riga, Col).Value = testo
    oFoglio.Range(aCols(Col) & Riga).Select
    
     
    If FontSize <> "" Then oapplicazione.Selection.Font.Size = FontSize
    
    If FontStyle <> "" Then oapplicazione.Selection.Font.FontStyle = FontStyle

 END SUB

SPERO DI ESSERE STATA CHIARA