Exporter des données Acesss vers un fichier excel

[Ensascience]

salut tous le monde;
je suis une debutante en ACess ...et
j ai besoin d'une macro ou d'un code vba qui me permetra de transferer des données de access vers un raport excel (un tableau ou il y a tous ces données) ; je veux creer un bouton sur mon formulaire qui aura un peu pres la meme fonction que le bouton Import Excel sur la barre outil de Access avec la possibilite del envoi automatique de ce raport vers un destinataire par outlook
j espere que vous pouriez me proposer une solution facile ...
MErci d'avance
-----

[matthieu2]

Bonjour,

Le but du forum est d'aider, pas de faire à ta place

Sinon, te proposer une solution facile etant donnée que tu es débutante (en VBA?) c'est pas gagné!

En tout cas, selon moi c'est tout à faisable. Ne connaissant pas trop access je peux difficilement t'aider sur la partie extraction par contre je peux t'aider pour la partie envoi du mail à partir de l'Excel.
Je t'envoie le code ASAP qu'il faudra adapter à ton cas particulier.

@ bientôt

[JPL]

Je t'envoie le code ASAP qu'il faudra adapter à ton cas particulier.

Pourquoi ne pas le poster ici en utilisant la balise Code ?

[matthieu2]

Tout à d'abord BONJOUR,

Pourquoi ne pas le poster ici en utilisant la balise Code ?

Car étant au boulot, j'ai pas le code avec moi, il est sur mon PC perso...

Du coup, voici le code. Dans un premier temps je fais charger les références qu'il faut pour pouvoir envoyer le mail:

Private Sub cmdActRef_Click()

    On Error Resume Next

    With ThisWorkbook.VBProject.References
        Application.DisplayAlerts = False
        .AddFromFile ("C:\Program Files\Microsoft Office\Office14\msoutl.olb")
        .AddFromFile ("C:\Program Files\Microsoft Office\Office14\SOCIALPROVIDER.DLL")
        .AddFromFile ("C:\Program Files\Microsoft Office\Office14\OUTLCTL.DLL")
    End With

    Application.DisplayAlerts = True
    On Error GoTo 0

    cmdSaveAndSent.Visible = True
    
    MsgBox "References are Activate, you can click on Save and Send", vbInformation, "Information"

End Sub

Je charge les références par un click utilisateur (car à l'époque j'avais pas réussi à le faire automatiquement à l'ouverture du fichier Excel - à adapter si besoin)

Une fois que les références sont loadés, voici le code que j'utilise:

Public Sub SaveAndSend()

    'Variables declaration
    Dim TheDate As String
    Dim TheName As String
    Dim TheName2 As String
    Dim TheAddress As String
    Dim AddressMail1 As String
    Dim AddressMail2 As String
    Dim Name_File As String


    'The variable take the value of now (when clicking on save and send)
    TheDate = Format(Now, "ddmmyyyy_hhnn")
    'The variables take the value of what you write in the text box
    TheName = txtName.text
    AddressMail1 = txtAddressMail1.text
    AddressMail2 = txtAddressMail2.text

    'If the name of the file is not written show an alert message
    If TheName = "" Then
        MsgBox "Please name your file", vbInformation, "Error"
        'Set focus to the text box
        txtName.Activate
        End
    End If
    
    'If the adress is not written show an alert message
    If AddressMail1 = "" Then
        MsgBox "Please enter an e-mail address", vbInformation, "Error"
        'Set focus to the text box
        txtAddressMail1.Activate
        End
    End If
    
    'PDF does not accept some characters so it will be replace automatically
    TheName2 = Replace(TheName, "|", "_")
    TheName2 = Replace(TheName2, "\", "_")
    TheName2 = Replace(TheName2, "/", "_")
    TheName2 = Replace(TheName2, ":", "_")
    TheName2 = Replace(TheName2, "*", "_")
    TheName2 = Replace(TheName2, "<", "_")
    TheName2 = Replace(TheName2, ">", "_")
    TheName2 = Replace(TheName2, """", "_")
    TheName2 = Replace(TheName2, "?", "_")
    TheName2 = Replace(TheName2, " ", "_")
    
    'If any option box is checked then show an alert message
    If OptGood.value = False Then
        If OptWrong.value = False Then
            MsgBox "Please select " & """Correct Results""" & " or " & """Incorrect Results""", vbInformation, "Error"
            End
        End If
    End If

    'ADAPT THE ADRESS IF THE FILE IS COPY TO ANOTHER COMPUTER
    'This adress is where the file will be save
    'TheAddress = "N:\Manufacturing Measuring Room\Mycrona result sheet outlook data\"
     TheAddress = "C:\Documents and Settings\zz0g50\Desktop\"

    'Put the Excel into pdf and save it in TheAdress
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        TheAddress & TheDate & "_" & TheName2 & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        From:=1, To:=1, OpenAfterPublish:=False

    'Drop the previous pdf created into a variable
    Name_File = TheAddress & TheDate & "_" & TheName2 & ".pdf"
    
    
    'You must enable "Microsoft Outlook Library" before run the application,
    'In VBA=> Tools / References / Check the 3 "Microsoft Outlook [...]"
    Dim ObjOutlook As New Outlook.Application
    Dim ObjMail

    Set ObjOutlook = New Outlook.Application
    Set ObjMail = ObjOutlook.CreateItem(olMailItem)

    'With the mail
    With ObjMail
        'Send to
        .To = AddressMail1
        'Copy CC
        .CC = AddressMail2
        'Subject of mail
        .Subject = "Results of Mycrona"
        'Body of mail (2 possibilities)
        'If the results are correct then write:
        If OptGood.value = True Then
            .Body = "Hello," & vbCr & vbCr & "Results of the Mycrona are enclosed." _
            & vbCr & vbCr & "The results are correct." _
            & vbCr & vbCr & "Regards," & vbCr & vbCr & "Manufacturing Metrology Room" _
            & vbCr & vbCr & "PS: Numbers of the filename correspond to dd/mm/yyyy_hh/mm"
        End If
        'If the results are uncorrect then write:
        If OptWrong.value = True Then
            .Body = "Hello," & vbCr & vbCr & "Results of the Mycrona are enclosed." _
            & vbCr & vbCr & "The Results are incorrect, please make an adjustment." _
            & vbCr & vbCr & "Regards," & vbCr & vbCr & "Manufacturing Metrology Room" _
            & vbCr & vbCr & "PS: Numbers of the filename correspond to dd/mm/yyyy_hh/mm"
        End If
        'Attachement
        .Attachments.Add Name_File
        'Show the e-mail
        '.Display
        'Send the e-mail
        .Send
    End With

    ObjOutlook.Quit

    'Clear textbox and initialize optionbox
    txtAddressMail2.text = ""
    txtName.text = ""
    OptGood.value = False
    OptWrong.value = False
    cmdSaveAndSent.Visible = False
    
End Sub

Dans un premier temps, je converti le fichier Excel en pdf (donc ne prend pas en compte cette partie si ça ne t'interesse pas). Pour créer et envoyer le mail, regarde à partir de " 'You must enable "Microsoft Outlook Library" before run the application,".

Bon courage.

[A voir en vidéo sur Futura]