Newsgroup: it.comp.appl.access
Titolo: Access 2003 e office 2010 standard

buongiorno, 
fino a ieri utilizzavo un applicativo creato in Access 2003 dal quale potevo generare una mail in automatico alla pressione di un pulsante oppure compilare un documento il tutto in automatico; office era la versione 2007 standard.
Oggi, nuovo PC mi ritrovo con office 2010 Standard al quale ho aggiunto Access 2003, i riferimenti mi sembrano gli stessi l'automatismo word sembra funzionare, ma quello con Outlook mi genera l'errore di run-time 429 "Il componente AcitveX non è in grado di creare l'oggetto"
questo il codice della sub
L'esecuzione si ferma sulla prima riga "Private Sub InviaMail()"
 
Private Sub InviaMail()
Dim OutApp As Object
    Dim OutMail As Object
    Dim SigString, Signature As String
    Dim HTML, SQL As String
    Dim allegato As String
    SQL = "SELECT SUB_2.id_sub, verifiche.id_sub_2, verifiche.Path_Esito FROM (SUB INNER JOIN SUB_2 ON SUB.id_sub = SUB_2.id_sub) INNER JOIN verifiche ON SUB_2.ID_SUB_2 = verifiche.id_sub_2 WHERE (((SUB_2.id_sub)=[forms]![M_sub]![id_Sub])"
 
 
        Set OutApp = CreateObject("Outlook.Application")
        OutApp.Session.Logon
        Set OutMail = OutApp.CreateItem(0)
          SigString = DLookup("Folder_EmailFirma", "Servizio") 'C:\Documents and Settings\876500\Dati Applicazioni\Microsoft\Signatures\Firma 150.htm"
 
            If Dir(SigString) <> "" Then
                Signature = GetBoiler(SigString)
            Else
                Signature = ""
            End If
 
        On Error Resume Next
        'With OutMail
            OutMail.To = DLookup("[Email]", "Strutture", "[id_struttura] = " & [id_Struttura]) 'Forms!M_POL_TRATT!EmailDL
            OutMail.CC = DLookup("emailCapo", "Strutture", "[id_struttura] = " & [id_Struttura]) 'Forms!M_POL_TRATT!EmailRP & "; " & Forms!M_POL_TRATT!EmailPM
            OutMail.BCC = ""
            OutMail.Subject = "CO 301/RFI del 17 Maggio 2013 - Trasmissione Verifiche Effettuate - SubaAppalto: N° S" & [Sub]
            OutMail.bodyformat = olFormatHTML
 
            HTML = "<html><head></head><body><br>la presente E-Mail è generata in maniera automatica" & "<br>"
 
            HTML = "<html><head></head><body> Questa E-mail è generata in automatico.<br>buongiorno,<br> in relazione a quanto stabilito dalla C.O. 301/RFI del 17 Maggio 2013 Punto II.10 'Documentazione per alimentazione Banca Dati Appalti e Subappalti del Gruppo FS', in allegato, si trasmette la documentazione relativa al SubAppalto in oggetto, strutturato come segue:<br>" & "<br>" & "<b>- Appaltatore:</b> " & DLookup("denominazione", "ditte", "id_ditta= " & id_Appaltatore) & "<br>"
'**************
               'HTML = HTML & "<b>- Subappalto:</b> " & DLookup("denominazione", "ditte", "id_ditta= " & id_Appaltatore) & ".<br>la documentazione trasmessa è relativa all'Appaltatore:" & "<br>"
            If Associazione Then
                HTML = HTML & "<b>- Subappaltatore:</b> " & DLookup("denominazione", "ditte", "id_ditta= " & id_Ditta) & ".<br>la documentazione trasmessa è relativa alle Imprese:" & "<br>"
            Else
                HTML = HTML & "<b>- Subappaltatore:</b> "
            End If
 
'*************************************
        Dim RTT As DAO.Recordset
        Set dbs = CurrentDb
        Set RTT = dbs.OpenRecordset("SELECT SUB_2.id_sub, Ditte.Denominazione FROM SUB_2 INNER JOIN Ditte ON SUB_2.id_Ditta = Ditte.id_Ditta WHERE SUB_2.id_sub= " & [Forms]![M_SUB]![id_sub] & ";")
                RTT.MoveFirst
                Do While Not RTT.EOF
                    Debug.Print RTT!id_sub
                    HTML = HTML & "- " & RTT!Denominazione & "<br>"
 
                RTT.MoveNext
                Loop
 
 
 
            Set RTT = Nothing
            Set dbs = Nothing
            '****************************************
 
            OutMail.HTMLbody = HTML & "" & "<br>Saluti Cordiali<br>" & "<br></body></html>" & Signature
            'OutMail.body = " Prova scrittura messaggio NON HTML" & Signature
 
            'OutMail.Attachments.Add "" & Path_word
            Dim pippo As String
         '   If InviaAttestazioneAssociazione And pdf1 Then
         '       pippo = "" & DLookup("Foldersub_attetsazioneATI", "servizio") & Path_attetstazione_Associazione
         '       OutMail.Attachments.Add (pippo)
         '   End If
         '   If InviaRichiesta And pdf2 Then
         '       pippo = "" & DLookup("Foldersub_richiesta", "servizio") & Path_Richiesta
         '       OutMail.Attachments.Add (pippo)
         '   End If
         '   If InviaSubcontratto And pdf3 Then
         '       pippo = "" & DLookup("Foldersub_subcontratto", "servizio") & Path_SubContratto
         '       OutMail.Attachments.Add (pippo)
         '   End If
         '   If InviaRelazioneCEL And pdf4 Then
         '       pippo = "" & DLookup("Foldersub_relazionecel", "servizio") & Path_Relazione_CEL
         '       OutMail.Attachments.Add (pippo)
         '   End If
         '   If InviaRelazioneDL And pdf5 Then
         '       pippo = "" & DLookup("Foldersub_relazionedl", "servizio") & Path_Relazione_DL
         '       OutMail.Attachments.Add (pippo)
         '   End If
            'If InviaAutorizzazione And pdf6 Then
        '        pippo = "" & DLookup("Foldersub_autorizzazione", "servizio") & Path_Autorizzazione
        '        OutMail.Attachments.Add (pippo)
        '    End If
        Dim RSTT As DAO.Recordset
        Set dbs = CurrentDb
        Set RSTT = dbs.OpenRecordset("SELECT SUB_2.id_sub, verifiche.id_sub_2,  verifiche.Path_esito FROM (SUB INNER JOIN SUB_2 ON SUB.id_sub = SUB_2.id_sub) INNER JOIN Verifiche ON SUB_2.ID_SUB_2 = verifiche.id_sub_2 WHERE SUB_2.id_sub= " & [Forms]![M_SUB]![id_sub] & ";")
                RSTT.MoveFirst
                Do While Not RSTT.EOF
                    Debug.Print RSTT!ID_SUB_2
                    pippo = RSTT!Path_Esito
                    If ReportFileStatus(pippo) Then
                        OutMail.Attachments.Add "" & RSTT!Path_Esito
                    Else
                        'MsgBox " Non tutti i file da Trasmettere sono stati allegati; Controlla e ripeti l'operazione"
                    'GoTo salta
                     End If
                RSTT.MoveNext
                Loop
 
            Set RSTT = Nothing
            Set dbs = Nothing
 
            OutMail.Display
            '.Send questo serve per inviarle senza visualizzarle
            '.Save Per SAlvare Il messaggio in bozze
 
            'application.sendkeys "%a" questa parte se decommentata serve a non ricevere la finestrella di Outlook che chiede di autorizzare l'invio
 
salta:
        'End With
        On Error GoTo 0
 
        Set OutMail = Nothing
        Set OutApp = Nothing
 
    'Riferimento = "Inviato tramite E-Mail"
    DataRiferimento = Date
End Sub
 
Il codice è molto sporco, utilizzato per varie Applicazioni, mi scuso per questo.
 
Mi date una Mano a risolvere il problema?
Grazie Raffaele


Dimenticavo, windows Seven 64

Hai verificato non ci sia un'altra istanza di MSO aperta...?
Nel caso perchè non usi quella con GETOBJECT...? intercetti l'errore 429 ed in caso usi CREATEOBJECT
 
 
@Alex