FAQ MS-Access
FAQ MS-AccessConsultez toutes les FAQ
Nombre d'auteurs : 140, nombre de questions : 926, dernière mise à jour : 15 juin 2021
Sommaire→VBA→Interaction avec d'autres applications- Comment lier une base Lotus Notes (*.nsf) et Access ?
- Comment migrer d'Access 2000 vers SQL Server 2000 ?
- Comment se connecter directement à SQL Server ?
- Comment lancer un programme et attendre la fin de son exécution avant de continuer ?
- Comment exécuter un programme ?
- Comment fermer un programme ouvert avec la fonction Shell ?
- Comment tuer un processus en connaissant le nom de sa fenêtre ?
- Comment lancer un exécutable et reprendre la main quand il a fini ?
- Comment envoyer un mail avec Lotus Notes ?
- Comment envoyer un e-mail avec une pièce attachée ?
- Comment ouvrir un fichier HTML, Word, PDF ou autre en utilisant l'exécutable associé ?
- Que faire quand l'API ShellExecute ne fonctionne pas ?
11.7.1. Applications Office
(32)
- 11.7.2. Interaction avec d'autres applications Trucs et Astuces
(7)
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.
Livre référence : "Migrer votre base de données Access vers SQL Server" de Marc Israël (ISBN : 2840824434).
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 '---------------------------
'--- 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 SubLien : 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.).
Dim ret As Long
ret = Shell("notepad.exe", vbNormalFocus)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 :
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 SubCertains 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.
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.
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 SubUn 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.
Lien : FAQ VB
Copiez ce code dans un module standard :
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 N° " & 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 N° " & Err.LastDllError
End If
End SubCréez un formulaire et placez-y un bouton nommé Command1. Puis copiez ce code dans le module du formulaire :
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 SubLa 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".
Lien : FAQ VB
'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 SubIl est aussi possible d'indiquer à Lotus Notes plusieurs destinataires en affectant un tableau de type Variant à la propriété sendto :
Dim recip(25) as Variant
recip(0) = "emailaddress1"
recip(1) = "emailaddress2"
maildoc.sendto = recipLien : 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.
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 SubCette solution fonctionne avec Outlook Express comme client e-mail. Elle reste à tester pour les autres services de messagerie.
Lien : Le publipostage avec AccessII. Publipostage vers le mail
Placez cette déclaration dans le module d'un formulaire :
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 LongLa 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 :
ShellExecute Me.hwnd, "open", "https://www.developpez.com", "", CurrentProject.Path, 1Lien : FAQ VB
Lien : Que faire quand l'API ShellExecute ne fonctionne pas ?
Déclarez une variable de type variant :
Dim Ret as VariantRécupérer le résultat de la fonction ShellExecute (ne pas oublier les parenthèses) dans cette variable :
Ret = ShellExecute(.....)
msgbox RetInterprétez le résultat retourné en fonction de la liste suivante :
- 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.
Lien : Comment ouvrir un fichier HTML, Word, PDF ou autre en utilisant l'exécutable associé ?