Developpez.com

Plus de 14 000 cours et tutoriels en informatique professionnelle à consulter, à télécharger ou à visionner en vidéo.

FAQ MS-AccessConsultez toutes les FAQ

Nombre d'auteurs : 140, nombre de questions : 926, dernière mise à jour : 30 mars 2017 

 
OuvrirSommaireVBAInteraction avec d'autres applications

Ce n'est pas de tout repos. Il existe un driver Lotus SQL ODBC (NotesSQL), avec lequel vous pourrez lier une vue Lotus (car les objets sont considérés comme des vues) dans Access.

Créé le 6 mars 2004  par Gaël Donat

Livre référence : "Migrer votre base de données Access vers SQL Server" de Marc Israël (ISBN : 2840824434).

Créé le 6 mars 2004  par Maxence HUBICHE
 
Sélectionnez
Public Sub connect() 
 '--------------------------------------- 
 ' Connexion au serveur SQL NomServeur
 '--------------------------------------- 
 ' Instanciation de la connexion 
 Set Cnx = New ADODB.Connection
 ' Paramètres de connexion 
 Cnx.ConnectionString = "Driver={SQL Server};server=NomServeur;UID=sa;PWD=;database=NomMDB" 
 Cnx.Open 
 ' Test de connexion 
 If Cnx.State = adStateOpen Then 
     MsgBox "connexion OK" 
 End If 
End Sub
Créé le 25 octobre 2004  par thorgal85
 
Sélectionnez

 '---------------------------
 '--- Déclaration des API ---
 '---------------------------
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As _
 Long, ByVal dwlProcessID As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

 '-----------------------------
 '--- Déclaration des CONSTANTES ---
 '-----------------------------
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STATUS_PENDING = &H103&

 '----------------
 '--- Fonction ---
 '----------------
Private Sub LancerProg(PathFilename As String)
Dim lhProcess As Long
Dim lProcessID As Long
Dim lpExitCode As Long

    ' Ouverture du programme + récupération de son handle
    ' La récupération du handle est nécessaire pour pouvoir ouvrir un processus sur celui-ci
    lProcessID = Shell(PathFilename, 1)
   
    ' Ouverture d'un processus sur le programme ouvert + récupération du handle du processus
    ' La récupération du handle est nécessaire pour obtenir des informations sur celui-ci
    lhProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, lProcessID)
   
    ' Boucle tant que la variable lpExitCode <> STATUS_PENDING (&H103&)
    Do
        ' Récupération du code de sortie du processus
            ' Si programme ouvert -> la variable lpExitCode = STATUS_PENDING
            ' Sinon -> la variable lpExitCode = 0. Donc fin de la boucle
        Call GetExitCodeProcess(lhProcess, lpExitCode)
       
        DoEvents ' Continue à exécuter les opérations effectuées par Access
       
    Loop While lpExitCode = STATUS_PENDING

    Call CloseHandle(lhProcess) 'Ferme le handle du processus

End Sub
Créé le 1er janvier 2005  par argyronet

Lien : Comment forcer Access à attendre la fin d'un traitement avant de continuer ?

Utilisez la fonction Shell. Vous pouvez indiquer dans le deuxième paramètre comment la fenêtre du programme doit s'afficher (si elle doit rester invisible, ou s'afficher normalement, ou en prenant tout l'écran, etc.).

 
Sélectionnez
Dim ret As Long
ret = Shell("notepad.exe", vbNormalFocus)
Créé le 1er janvier 2005  par nightfall

Lien : FAQ VB
Lien : Comment ouvrir un fichier HTML, Word, PDF ou autre en utilisant l'exécutable associé ?
Lien : Que faire quand l'API ShellExecute ne fonctionne pas ?

Vous trouverez une méthode possible dans le code source ci-dessous. La procédure KillApp() ferme le programme dont l'identifiant est passé en paramètre. Vous pouvez utiliser la valeur renvoyée par la fonction Shell().

La seule ligne contenue dans la procédure KillApp() a pour effet d'énumérer toutes les fenêtres ouvertes, et d'appeler pour chacune d'entre elles la fonction CloseWindow().
La fonction CloseWindow() regarde si la fenêtre en cours appartient au processus que l'on doit fermer, et si elle contient un menu Système (menu qui apparaît quand on clique sur l'icône de la fenêtre). Si c'est le cas, elle ferme la fenêtre.

Insérez ce code dans un module standard :

 
Sélectionnez
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, _
   lpdwprocessid As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, _
   ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
   ByVal nIndex As Long) As Long
Private Const WM_CLOSE = &H10
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU = &H80000

Private Function CloseWindow(ByVal hwnd As Long, ByVal hInstance As Long) As Long

Dim idproc As Long

idproc = 0

' Reçoit dans idproc l'id du processus lié à cette fenêtre
GetWindowThreadProcessId hwnd, idproc
If (idproc = hInstance) And ((GetWindowLong(hwnd, GWL_STYLE) And WS_SYSMENU) = WS_SYSMENU) Then
     PostMessage hwnd, WM_CLOSE, 0, 0
End If

' Obligatoire pour qu'EnumWindows continue l'énumération
CloseWindow = True

End Function

Public Sub KillApp(hInstance As Long)

EnumWindows AddressOf CloseWindow, hInstance

End Sub

Certains programmes n'acceptent pas d'être ouverts plusieurs fois en même temps. Pour cela, ils commencent par chercher si une instance du programme est déjà en mémoire. Si c'est le cas, ils terminent l'instance qui vient d'être créée, et si une nouvelle fenêtre doit être ouverte, c'est l'ancienne instance qui le fait.

Avec ce code source vous ne pourrez donc pas, par exemple, fermer une fenêtre de l'explorateur Windows ouverte par Shell() car le processus dont l'id vous est renvoyé est automatiquement fermé, et la nouvelle fenêtre est ouverte par l'instance qui était déjà en mémoire.

Créé le 1er janvier 2005  par nightfall

Lien : FAQ VB
Lien : Comment ouvrir un fichier HTML, Word, PDF ou autre en utilisant l'exécutable associé ?
Lien : Que faire quand l'API ShellExecute ne fonctionne pas ?

Le code suivant est assez similaire à celui de la question précédente, la différence résidant dans le fait que vous ne connaissez pas l'identifiant du processus mais juste le titre de la fenêtre.

Ce code doit être placé dans un module standard. Le principe utilisé est celui d'une énumération à l'aide d'un callback classique : la fonction EnumWindows énumère toutes les fenêtres ouvertes et appelle la fonction EnumCallback pour chacune d'entre elles. Celle-ci ferme la fenêtre si son titre contient l'expression recherchée.

 
Sélectionnez
Declare Function EnumWindows Lib "user32" (ByVal wndenmprc As Long, ByVal lParam As Long) As Long 
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, _
                                                                    ByVal lpString As String, _
                                                                    ByVal cch As Long) As Long 
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
                                                                ByVal wParam As Long, _
                                                                lParam As Any) As Long
Public Const WM_CLOSE = &H10

Private AppCible As String

Public Function EnumCallback(ByVal app_hWnd As Long, ByVal param As Long) As Long

Dim buf As String * 256
Dim Titre As String
Dim Longueur As Long

' Récupère le titre de la fenêtre
Longueur = GetWindowText(app_hWnd, buf, Len(buf))
Titre = Left$(buf, Longueur)

' Vérifie si le titre de la fenêtre correspond au nom recherché
If InStr(Titre, AppCible) <> 0 Then
    'Ferme la fenêtre
    SendMessage app_hWnd, WM_CLOSE, 0, 0
End If

' Poursuit l'énumération
EnumCallback = 1

End Function 

Public Sub KillApp(App_Cherchee As String)

AppCible = App_Cherchee
' Demande à Windows d'énumérer les fenêtres ouvertes
EnumWindows AddressOf EnumCallback, 0

End Sub

Un appel du type KillApp "Excel" fermera Microsoft Excel. Attention d'éviter l'utilisation de termes trop simples pouvant se trouver dans le titre d'une fenêtre d'une autre application.

Créé le 1er janvier 2005  par Jean-Marc Rabilloud

Lien : FAQ VB

Copiez ce code dans un module standard :

 
Sélectionnez
Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" _
                                      (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, _
                                       ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
                                       ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
                                       ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
                                       lpStartupInfo As STARTUPINFO, _
                                       lpProcessInformation As PROCESS_INFORMATION) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long

'Type pour gérer les lancements de processus
Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

'Info sur un processus
Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type

Public Const NORMAL_PRIORITY_CLASS = &H20&
Public Const STILL_ACTIVE = &H103&

Public Sub AttendreFinProcess(proc As PROCESS_INFORMATION, Optional timeout As Long = 60)

Dim Ret As Long
Dim tms As Single
Dim exitcode As Long
   
'Attendre la fin de la commande
tms = Timer
Ret = GetExitCodeProcess(proc.hProcess, exitcode)
Do While Ret <> 0 And exitcode = STILL_ACTIVE
    Ret = GetExitCodeProcess(proc.hProcess, exitcode)
    DoEvents
    Sleep 100
    If Timer - tms > timeout Then
        Err.Raise STILL_ACTIVE, "AttendreFinProcess", "Timeout sur l'attente de la fin d'un process"
    End If
Loop
If Ret = 0 Then
    Err.Raise Err.LastDllError, "AttendreFinProcess", "Erreur système  " & Err.LastDllError
End If

End Sub

Public Sub LancerProcess(sExe As String, proc As PROCESS_INFORMATION)

Dim start As STARTUPINFO
Dim Ret As Long
   
'StartupInfo pour le processus qui lancera la commande
start.cb = Len(start)
'Lancement de la commande
Ret& = CreateProcess(0&, sExe, 0&, 0&, 0&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
If Ret = 0 Then
    Err.Raise Err.LastDllError, "LancerProcess", "Erreur système  " & Err.LastDllError
End If
   
End Sub

Créez un formulaire et placez-y un bouton nommé Command1. Puis copiez ce code dans le module du formulaire :

 
Sélectionnez
Private Sub Command1_Click()
   
Dim proc As PROCESS_INFORMATION
   
On Error GoTo errortag
proc.hProcess = -1
proc.hThread = -1
Debug.Print "Debut du processus"
Call LancerProcess("notepad", proc)
Call AttendreFinProcess(proc)
Debug.Print "fin du processus"
Call CloseHandle(proc.hProcess)
Call CloseHandle(proc.hThread)
  
Exit Sub
   
errortag:
If proc.hProcess <> -1 Then CloseHandle proc.hProcess
If proc.hThread <> -1 Then CloseHandle proc.hThread
MsgBox Err.Number & " - " & Err.Description
   
End Sub

La fonction AttendreFinProcess() attend la fin d'un processus tant que le temps indiqué par le paramètre timeout n'est pas écoulé.

Exécutez le projet et cliquez sur le bouton de commande. Le Notepad se lance. Lorsque vous le fermez, la fenêtre d'exécution (Ctrl + G) affiche "fin du processus".

Créé le 1er janvier 2005  par abelman

Lien : FAQ VB

 
Sélectionnez
'Envoi d'un mail avec Lotus Notes
' Subject : sujet du mail
' Attachment : nom d'une pièce jointe
' Recipient : adresse e-mail du destinataire principal
' ccRecipient : destinataire en copie
' bccRecipient : destinataire en copie invisible
' BodyText : corps du mail
' SaveIt : mettre à True pour que le mail soit sauvegardé
' Password : mot de passe

Public Sub SendNotesMail(ByVal Subject As String, ByVal Attachment As String, _
                         ByVal Recipient As String, ByVal ccRecipient As String, _
                         ByVal bccRecipient As String, ByVal BodyText As String, _
                         ByVal SaveIt As Boolean, ByVal Password As String)
                         
    Dim Maildb As Object      'La base des mails
    Dim UserName As String    'Le nom d'utilisateur
    Dim MailDbName As String  'Le nom de la base des mails
    Dim MailDoc As Object     'Le mail
    Dim AttachME As Object    'L'objet pièce jointe en RTF
    Dim Session As Object     'La session Notes
    Dim EmbedObj As Object    'L'objet incorporé
   
    ' Crée une session notes
    Set Session = CreateObject("Notes.NotesSession")
   
    '*** Cette ligne est réservée aux versions 5.x et supérieures : ***
    Session.Initialize (Password)
   
    ' Récupère le nom d'utilisateur et crée le nom de la base des mails
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
   
    ' Ouvre la base des mails
    Set Maildb = Session.GETDATABASE("", MailDbName)
    If Not Maildb.ISOPEN Then Maildb.OPENMAIL
       
    ' Paramètre le mail à envoyer
    Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc.Form = "Memo"
    MailDoc.sendto = Recipient
    MailDoc.CopyTo = ccRecipient
    MailDoc.BlindCopyTo = bccRecipient
    MailDoc.Subject = Subject
    MailDoc.Body = BodyText
    MailDoc.SAVEMESSAGEONSEND = SaveIt
   
    ' Prend en compte les pièces jointes
    If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
     
    ' Envoie le mail
    MailDoc.PostedDate = Now()
    MailDoc.SEND 0, Recipient
   
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
End Sub

Il est aussi possible d'indiquer à Lotus Notes plusieurs destinataires en affectant un tableau de type Variant à la propriété sendto :

 
Sélectionnez
Dim recip(25) as Variant

recip(0) = "emailaddress1"
recip(1) = "emailaddress2"
maildoc.sendto = recip
Créé le 1er janvier 2005  par Team Access

Lien : FAQ VB


Pour exécuter ce code, il faut ajouter les références : Microsoft CDO for Windows 2000 Library et Microsoft ActiveX Data Objects 2.X Library.

 
Sélectionnez
Option Compare Database
Option Explicit

Private Sub cmdEnvoyer_Click()
' txtForm
    CDOSendMail txtFrom, txtTo, txtSubject, txtBody, txtAttach
    ' txtForm : Mail de l'envoyeur
    ' txtTo : Mail de destination
    ' txtSubject = Objet
    ' txtBody = contenu
    ' txtAttach = chemin complet du fichier
End Sub

Public Sub CDOSendMail(SendFrom As String, _
                       SendTo As String, _
                       Subject As String, _
                       PlainTextBody As String, _
                       FullPathFileName As String)
Dim cdoMail As CDO.Message
Dim iBp As CDO.IBodyPart ' for IBodyPart on message
Dim iBp1 As CDO.IBodyPart
Dim Flds As ADODB.Fields
Dim Stm  As ADODB.Stream

    Set cdoMail = New CDO.Message
    With cdoMail
        .From = SendFrom
        .To = SendTo
        .Subject = Subject
        ''Set iBp = .BodyPart
        Set iBp = cdoMail   '??
   
        ' TEXT BODYPART
        ' Add the body part for the text/plain part of message
        Set iBp1 = iBp.AddBodyPart
   
        ' Set the fields here
        Set Flds = iBp1.Fields
        Flds("urn:schemas:mailheader:content-type") = "text/plain; charset=""iso-8859-1"""
        Flds.Update
   
        ' Get the stream and add the message
        Set Stm = iBp1.GetDecodedContentStream
        Stm.WriteText PlainTextBody
        Stm.Flush
  
        ' HTML BODYPART
        ' Do the HTML part here
        Set iBp1 = iBp.AddBodyPart
        ' Set the content-type field here
        Set Flds = iBp1.Fields
        Flds("urn:schemas:mailheader:content-type") = "text/html"
        Flds.Update
        ' Get the stream and add message HTML text to it
        Set Stm = iBp1.GetDecodedContentStream
        Stm.WriteText "<HTML><H1>this is some content for the body part object</H1></HTML>"
        Stm.Flush
   
        ' Now set the Message object's Content-Type header
        ' to multipart/alternative
        Set Flds = iBp.Fields
        Flds("urn:schemas:mailheader:content-type") = "multipart/alternative"
        Flds.Update
        .AddAttachment FullPathFileName
        .Send
    End With
End Sub

Cette solution fonctionne avec Outlook Express comme client e-mail. Elle reste à tester pour les autres services de messagerie.

Mis à jour le 14 octobre 2007  par Papy Turbo

Lien : Le publipostage avec AccessII. Publipostage vers le mail

Placez cette déclaration dans le module d'un formulaire :

 
Sélectionnez
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

La ligne suivante affiche le site Developpez.com dans le navigateur par défaut, en fournissant le répertoire de votre application comme répertoire par défaut :

 
Sélectionnez
ShellExecute Me.hwnd, "open", "http://www.developpez.com", "", CurrentProject.Path, 1
Mis à jour le 14 octobre 2007  par nightfall

Lien : FAQ VB
Lien : Que faire quand l'API ShellExecute ne fonctionne pas ?

Déclarez une variable de type variant :

 
Sélectionnez

					Dim Ret as Variant
				

Récupérer le résultat de la fonction ShellExecute (ne pas oublier les parenthèses) dans cette variable :

 
Sélectionnez

					Ret = ShellExecute(.....)
					msgbox Ret
				

Interprétez le résultat retourné en fonction de la liste suivante :

Résultat de ShellExecute
  • 0 : le système manque de mémoire ou de ressources, l'exécutable est corrompu ou réallocations non valides ;
  • 2 : fichier non trouvé ;
  • 3 : chemin non trouvé ;
  • 5 : une tentative a été faite pour se lier dynamiquement à une tâche, ou il y a eu une erreur de partage ou de protection réseau ;
  • 6 : la bibliothèque requiert des segments de données séparés pour chaque tâche ;
  • 8 : il n'y a pas assez de mémoire disponible pour lancer l'application ;
  • 10 : version de Windows incorrecte ;
  • 11 : le fichier exécutable n'est pas correct, il se peut que ce ne soit pas une application Windows, ou qu'il y ait une erreur dans le fichier .EXE ;
  • 12 : l'application a été conçue pour un autre système d'exploitation ;
  • 13 : l'application a été conçue pour MS-DOS 4.0 ;
  • 14 : le type de fichier exécutable est inconnu ;
  • 15 : tentative de chargement d'une application en mode réel ;
  • 16 : tentative de charger une seconde instance d'un fichier exécutable contenant plusieurs segments de données qui ne sont pas marqués en lecture seule ;
  • 19 : tentative de charger un fichier exécutable compressé, le fichier doit être décompressé avant d'être chargé ;
  • 20 : fichier de bibliothèque liée dynamiquement (DLL) incorrect, une des DLL requises pour exécuter cette application est corrompue ;
  • 21 : l'application requiert les extensions Microsoft Windows 32-bits ;
  • 31 : il n'y a pas d'association avec le type de fichier spécifié, ou il n'y a pas d'association pour l'action choisie pour le type de fichier choisi.
Créé le 31 mars 2008  par Philippe JOCHMANS

Lien : Comment ouvrir un fichier HTML, Word, PDF ou autre en utilisant l'exécutable associé ?

  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2013 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.