Private Declare Function SHShutDownDialog Lib _
"shell32" Alias "#60" (ByVal YourGuess As Long) As Long
Private Sub Arreter()
    SHShutDownDialog 0
End Sub

Const shrdNoMRUString = &H2
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
 
Private Declare Function GetVersionEx Lib "kernel32" Alias _
"GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
 
Private Declare Function SHRunDialog Lib "shell32" Alias "#61" _
(ByVal hOwner As Long, ByVal Unknown1 As Long, ByVal Unknown2 As _
Long, ByVal szTitle As String, ByVal szPrompt As String, _
ByVal uFlags As Long) As Long
 
Function WindowsNT() As Boolean
    Dim Info As OSVERSIONINFO
    Dim Result As Integer
    Info.dwOSVersionInfoSize = Len(Info)
    'Récupere la version de Windows
    Result = GetVersionEx(Info)
    WindowsNT = (Info.dwPlatformId = 2)
End Function
Public Sub AfficherExecuter()
    Dim Titre As String, Message As String
    Titre = "Lancer un programme"
    Message = "Tapez le nom d'un programme ou bien " & _
       "utilisez le bouton parcourir"
    'Si windows NT, alors utiliser unicode
    If WindowsNT Then
        SHRunDialog 0, 0, 0, StrConv(Titre, vbUnicode), _
            StrConv(Message, vbUnicode), 0
        'sinon, utiliser un string normal
    Else
        SHRunDialog 0, 0, 0, Titre, Message, 0
    End If
End Sub

Public Type Police
  Nom As String
  Taille As Long
  Souligne As Boolean
  Italique As Boolean
  Gras As Boolean
  Barre As Boolean
  Couleur As Long
End Type
 
Const LOGPIXELSY = 90
Const FW_NORMAL = 400
Const FW_GRAS = 700
Const DEFAULT_CHARSET = 1
Const OUT_DEFAULT_PRECIS = 0
Const CLIP_DEFAULT_PRECIS = 0
Const DEFAULT_QUALITY = 0
Const DEFAULT_PITCH = 0
Const FF_ROMAN = 16
Const CF_PRINTERFONTS = &H2
Const CF_SCREENFONTS = &H1
Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Const CF_EFFECTS = &H100&
Const CF_FORCEFONTEXIST = &H10000
Const CF_INITTOLOGFONTSTRUCT = &H40&
Const CF_LIMITSIZE = &H2000&
Const CF_NOSCRIPTSEL = &H800000
Const REGULAR_FONTTYPE = &H400
Const LF_FACESIZE = 32
Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40
 
 
 
Private Type CHOOSEFONT
        lStructSize As Long
        hwndOwner As Long   
        hDC As Long                
        lpLogFont As Long        
        iPointSize As Long       
        flags As Long             
        rgbColors As Long        
        lCustData As Long          
        lpfnHook As Long         
        lpTemplateName As String 
        hInstance As Long        
        lpszStyle As String       
        nFontType As Integer     
        MISSING_ALIGNMENT As Integer
        nSizeMin As Long           
        nSizeMax As Long        
End Type
Private Type LOGFONT
  lfHeight As Long
  lfWidth As Long
  lfEscapement As Long
  lfOrientation As Long
  lfWeight As Long
  lfItalic As Byte
  lfUnderline As Byte
  lfStrikeOut As Byte
  lfCharSet As Byte
  lfOutPrecision As Byte
  lfClipPrecision As Byte
  lfQuality As Byte
  lfPitchAndFamily As Byte
  lfFaceName As String * 31
End Type
 
 
 
Private Declare Function CHOOSEFONT Lib "comdlg32.dll" _
 Alias "ChooseFontA" (pChoosefont As CHOOSEFONT) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias _
 "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function GlobalLock Lib "kernel32" _
 (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" _
 (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" _
 (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" _
 (ByVal hMem As Long) As Long
 
 
Public Function ChoisirPolice(Handle As Long, _
      PoliceParDefaut As Police) As Police
 
    Dim Boite As CHOOSEFONT, LaPolice As LOGFONT, _
      hMem As Long, pMem As Long
    Dim resultat As Long, Retour As Police
    '*****************************************
    'definit la police par defaut à afficher
    LaPolice.lfStrikeOut = PoliceParDefaut.Barre
    LaPolice.lfWeight = IIf(PoliceParDefaut.Gras, _
        FW_GRAS, FW_NORMAL)
    LaPolice.lfItalic = PoliceParDefaut.Italique
    LaPolice.lfUnderline = PoliceParDefaut.Souligne
    LaPolice.lfHeight = -PoliceParDefaut.Taille * _
     GetDeviceCaps(GetDC(Handle), LOGPIXELSY) / 72
    If PoliceParDefaut.Nom = "" Then _
         PoliceParDefaut.Nom = "Tahoma"
    LaPolice.lfFaceName = PoliceParDefaut.Nom & _
         vbNullChar  'Nom de la police par defaut
    '******************************************
    ' Creer une structure LOGFont en memoire.
    hMem = GlobalAlloc(GMEM_MOVEABLE _
         Or GMEM_ZEROINIT, Len(LaPolice))
    'Verouille et recupere le pointeur vers la structure
    pMem = GlobalLock(hMem)
    'Copie la structure
    CopyMemory ByVal pMem, LaPolice, Len(LaPolice)
    'Initialise la boite de dialogue
    Boite.lStructSize = Len(Boite)
    Boite.hwndOwner = Handle
    'Affecte la police par defaut
    Boite.lpLogFont = pMem
    'defini la taille (10*La taille de la police)
    Boite.iPointSize = 120 'PoliceParDefaut.Taille * 10
    'Personalise la boite
    Boite.flags = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or _
       CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZE Or _
       CF_NOSCRIPTSEL
    'Fixe la couleur
    Boite.rgbColors = PoliceParDefaut.Couleur
    Boite.nFontType = REGULAR_FONTTYPE
    'Definit les tailles possibles
    Boite.nSizeMin = 6
    Boite.nSizeMax = 72
    'Ouvre la boite
    resultat = CHOOSEFONT(Boite)
    If resultat <> 0 Then
        CopyMemory LaPolice, ByVal pMem, Len(LaPolice)
        'Prepare le resultat
        Retour.Nom = Left(LaPolice.lfFaceName, _
            InStr(LaPolice.lfFaceName, vbNullChar) - 1)
        Retour.Taille = Boite.iPointSize \ 10
        Retour.Couleur = Boite.rgbColors
        'La police est en gras lorsque largeur n'est pas normale
        Retour.Gras = LaPolice.lfWeight > FW_NORMAL
        Retour.Italique = LaPolice.lfItalic
        Retour.Souligne = LaPolice.lfUnderline
        Retour.Barre = LaPolice.lfStrikeOut
     End If
   'Libère la mémoire
    resultat = GlobalUnlock(hMem) 
    resultat = GlobalFree(hMem)
    ChoisirPolice = Retour
End Function

Dim P As Police
'Recupere la police actuelle
'pour alimenter les valeurs par
'défaut de la boîte de dialogue
With P
.Barre = False
.Couleur = Lbl_Texte.ForeColor
.Gras = Lbl_Texte.FontBold
.Italique = Lbl_Texte.FontItalic
.Souligne = Lbl_Texte.FontUnderline
.Taille = Lbl_Texte.FontSize
.Nom = Lbl_Texte.fontname
End With
'Affiche la boite de dialogue
P = ChoisirPolice(Me.Hwnd, P)
'Applique la nouvelle valeur au controle
With Lbl_Texte
'si taille=0 alors signife annuler
If P.Taille <> 0 Then
.ForeColor = P.Couleur
.FontBold = P.Gras
.FontItalic = P.Italique
.fontname = P.Nom
.FontUnderline = P.Souligne
.FontSize = P.Taille
End If
End With

'Declaration de l'API
Private Declare Function ShellAbout Lib "shell32.dll" Alias _
"ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, _
ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
 
'Procedure sur le clique d'un bouton
Private Sub AfficherApropos_Click()
Dim Titre As String, Message As String
Titre = "Sources Access"
Message = "Ceci est un exemple de developpez.com sur l'utilisation des API"
ShellAbout me.hwnd, Titre, Message, VICon
End Sub

Private Const MAX_PATH = 160
Private Type DSBROWSEINFO
    cbStruct As Long
    hwndOwner As Long
    pszCaption As String
    pszTitle As String
    pszRoot As String
    pszPath As Long
    cchPath As Long
    dwFlags As Long
    pfnCallback As Long
    lParam As Long
    dwReturnFormat As Long
    pUserName As String
    pPassword As String
    pszObjectClass As String
    cchObjectClass As Long
End Type
Private Declare Function DsBrowseForContainer Lib "dsuiext" Alias _ 
    "DsBrowseForContainerA" (pInfo As DSBROWSEINFO) As Long
Public Function ActiveDirectory() as string
    Dim dsbi As DSBROWSEINFO, szResult As String
    szResult = Space(MAX_PATH)
    dsbi.cbStruct = Len(dsbi)
    dsbi.pszCaption = "Active Directory"
    dsbi.pszTitle = "Choisir une ressource"
    dsbi.pszPath = StrPtr(szResult)
    dsbi.cchPath = Len(szResult)
    'Appel de la fonction
    DsBrowseForContainer dsbi
    'Renvoit le résultat
    ActiveDirectory=szResult
End Function

Msgbox ActiveDirectory()

Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias _
"ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Private Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As String
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
Public Function ShowColor(Handle As Long) As Long
    Dim cc As CHOOSECOLOR
    Dim Custcolor(16) As Long
    Dim lReturn As Long
 
    'set the structure size
    cc.lStructSize = Len(cc)
    'Set the owner
    cc.hwndOwner = Handle
    'set the custom colors (converted to Unicode)
    cc.lpCustColors = StrConv(CustomColors, vbUnicode)
    'no extra flags
    cc.flags = 0
 
    'Show the 'Select Color'-dialog
    If CHOOSECOLOR(cc) <> 0 Then
        ShowColor = cc.rgbResult
        CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
    Else
        ShowColor = -1
    End If
End Function

Dim lacouleur as long
lacouleur=ShowColor(Me.hwnd)

'Déclaration de l'API
Private Declare Function DoFileDownload Lib "shdocvw.dll" _
(ByVal lpszFile As String) As Long
 
 
Public Sub TelechargerFichier(Fichier as string)
   DoFileDownload StrConv(Fichier, vbUnicode)
End Sub

TelechargerFichier("d:\test.mdb")
TelechargerFichier(""http://www.monsite.fr/monfichier.zip")

Const MB_DEFBUTTON1 = &H0&
Const MB_DEFBUTTON2 = &H100&
Const MB_DEFBUTTON3 = &H200&
Const MB_ICONASTERISK = &H40&
Const MB_ICONEXCLAMATION = &H30&
Const MB_ICONHAND = &H10&
Const MB_ICONINFORMATION = MB_ICONASTERISK
Const MB_ICONQUESTION = &H20&
Const MB_ICONSTOP = MB_ICONHAND
Const MB_OK = &H0&
Const MB_OKCANCEL = &H1&
Const MB_YESNO = &H4&
Const MB_YESNOCANCEL = &H3&
Const MB_ABORTRETRYIGNORE = &H2&
Const MB_RETRYCANCEL = &H5&
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" _
(ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, _
ByVal wType As Long) As Long

Dim reponse as long
reponse=MessageBox(me.Hwnd, "Voulez vous continuer", _
"Demande de confirmation", MB_YESNO + MB_ICONQUESTION))
If reponse=VbYes then 
    '..........
    'code à effectuer si l'utilisateur clique sur Oui
End if

Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Const EWX_POWEROFF = 8
 
Private Declare Function SHRestartSystemMB Lib "shell32" _
Alias "#59" (ByVal hOwner As Long, ByVal sExtraPrompt As String, _
ByVal uFlags As Long) As Long
 
Private Sub AfficherRedemarrer()
    SHRestartSystemMB 0, vbNullString, EWX_REBOOT
End Sub

	PrintBox "Impression PDF", "*PDF*", 3

'---------------------------------------------------------------------------------------
'*                        Boîte dialogue d'impression étendue                          *
'---------------------------------------------------------------------------------------
 
'***************************************************************************************
'*                                       API                                           *
'***************************************************************************************
' Pour remplacement de AddressOf  Access 97
#If VBA6 Then
#Else
    Private Declare Function GetCurrentVbaProject _
		Lib "vba332.dll" Alias "EbGetExecutingProj" (hProject As Long) As Long
    Private Declare Function GetFuncID _
		Lib "vba332.dll" Alias "TipGetFunctionId" (ByVal hProject As Long, _
			ByVal strFunctionName As String, ByRef strFunctionId As String) As Long
    Private Declare Function GetAddr _
		Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" (ByVal hProject As Long, _
			ByVal strFunctionId As String, ByRef lpfn As Long) As Long
#End If
' Déplace une zone de mémoire
Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, _
	ByVal length As Long)
' Récupère les couleurs système
Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, _
	ByVal nIDDlgItem As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, _
	ByVal nIndex As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias _
	"SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
	ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, _
	ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, _
	ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
	ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, _
	ByVal lpString As String) As Long
Private Declare Function GetProfileSection Lib "kernel32" Alias _
	"GetProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, _
	ByVal nSize As Long) As Long
'***************************************************************************************
'*                                       Types                                         *
'***************************************************************************************
' Type Point pour API
Private Type CWPSTRUCT
    lParam As Long
    wParam As Long
    message As Long
    hWnd As Long
End Type
'***************************************************************************************
'*                                    Constantes                                       *
'***************************************************************************************
Private Const GWL_HINSTANCE = (-6)
Private Const WH_CALLWNDPROC = 4
Private Const WM_ACTIVATE = &H6
Private Const WM_SETTEXT = &HC
Private Const BM_CLICK = &HF5
Private Const MAX_SECTION = 2048
Private Const CB_SETCURSEL = &H14E
Private Const WM_COMMAND = &H111
Private Const CBN_SELCHANGE = 1
Private Const CB_GETLBTEXT = &H148
Private Const CB_GETCOUNT = &H146
'***************************************************************************************
'*                                    Variables                                        *
'***************************************************************************************
' Variables de fonctionnement de PrintBox
Private PB_NbCopies As String
Private PB_SortPages As Boolean
Private PB_PageFrom As String
Private PB_pageTo As String
Private PB_Title As String
Private PB_PrintImmediate As Boolean
Private PB_Printer As String
Private PB_AppOldProc As Long  ' Procédure de gestion des messages de la fenêtre d'application
'***************************************************************************************
'*                                    FONCTIONS                                        *
'***************************************************************************************
 
'---------------------------------------------------------------------------------------
' Gestion des messages de l'application en attente d'ouverture de la boîte de dialogue
'---------------------------------------------------------------------------------------
' wParam et lParam    : Paramètres du message
'---------------------------------------------------------------------------------------
Private Function AppProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim lCWP As CWPSTRUCT   ' Structure pour paramètres des messages
    Dim lClass As String    ' Nom de la classe de la fenêtre
    Dim lHwnd As Long
    Dim lPos As Long
    Dim lRet As Long
    Dim lTexte As String
    On Error Resume Next    ' Pas de capture d'erreur dans les fonctions CallBack
    ' Copie les paramètres dans une structure
    RtlMoveMemory lCWP, ByVal lParam, Len(lCWP)
    ' Si message de création
    If lCWP.message = WM_ACTIVATE Then
        ' Lecture du nom de la classe
        lClass = Space(255)
        lClass = left(lClass, GetClassName(lCWP.hWnd, ByVal lClass, 255))
        ' Les boîtes de dialogue ont comme classe : #32770
        If lClass = "#32770" Then
            If PB_Title <> "" Then
                SetWindowText lCWP.hWnd, PB_Title
            End If
            If PB_Printer <> "" Then
                ' Choix de l'imprimante
                lHwnd = GetDlgItem(lCWP.hWnd, 1139)
                For lPos = 0 To SendMessage(lHwnd, CB_GETCOUNT, 0, 0&)
                    lTexte = Space(255)
                    lRet = SendMessage(lHwnd, CB_GETLBTEXT, lPos, ByVal lTexte)
                    If left(lTexte, lRet) Like PB_Printer Then
                        Call SendMessage(lHwnd, CB_SETCURSEL, lPos, 0&)
                        SendMessage lCWP.hWnd, WM_COMMAND, _
							(CBN_SELCHANGE * &H10000) + 1139, lHwnd
                        Exit For
                    End If
                Next
            End If
            If PB_NbCopies <> 1 Then
                ' Recherche de la zone nombre de copies
                lHwnd = GetDlgItem(lCWP.hWnd, 1154)
                ' Met à jour la zone de texte
                Call SendMessage(lHwnd, WM_SETTEXT, Len(PB_NbCopies), ByVal PB_NbCopies)
            End If
            If Not PB_SortPages Then
                ' Recherche de la case triés
                lHwnd = GetDlgItem(lCWP.hWnd, 1041)
                Call SendMessage(lHwnd, BM_CLICK, 0, 0&)
            End If
            If PB_PageFrom > 0 Or PB_pageTo > 0 Then
                ' Click sur la case pages
                lHwnd = GetDlgItem(lCWP.hWnd, 1058)
                Call SendMessage(lHwnd, BM_CLICK, 0, 0&)
                ' Pages à imprimer
                lHwnd = GetDlgItem(lCWP.hWnd, 1152)
                Call SendMessage(lHwnd, WM_SETTEXT, Len(PB_PageFrom), ByVal PB_PageFrom)
                lHwnd = GetDlgItem(lCWP.hWnd, 1153)
                Call SendMessage(lHwnd, WM_SETTEXT, Len(PB_pageTo), ByVal PB_pageTo)
            End If
            If PB_PrintImmediate Then
                ' Click sur bouton OK
                lHwnd = GetDlgItem(lCWP.hWnd, 1)
                Call SendMessage(lHwnd, BM_CLICK, 0, 0&)
            End If
            ' Stoppe la surveillance des messages
            Call UnhookWindowsHookEx(PB_AppOldProc)
        End If
    End If
    ' Appelle la fonction de gestion des messages d'origine
    AppProc = CallNextHookEx(PB_AppOldProc, nCode, wParam, ByVal lParam)
End Function
 
'---------------------------------------------------------------------------------------
' Fonction publique d'appel de la boîte de dialogue d'impression
'---------------------------------------------------------------------------------------
Public Function PrintBox(Optional pTitle As String = "", _
				Optional pPrinter As String, _
				Optional pNbCopies As Integer = 1, _
				Optional pSortPages As Boolean = True, _
				Optional pPageFrom As Integer, Optional pPageto As Integer, _
				Optional pPrintImmediate As Boolean = False)
    On Error GoTo Gestion_Erreurs
    ' Titre de la fenêtre
    PB_Title = pTitle
    ' Nombre de copies
    PB_NbCopies = pNbCopies
    ' Trier les pages
    PB_SortPages = pSortPages
    ' Pages à imprimer
    PB_PageFrom = pPageFrom
    PB_pageTo = pPageto
    ' Impression immédiate
    PB_PrintImmediate = pPrintImmediate
    ' Imprimante
    PB_Printer = pPrinter
    ' Surveille les messages de l'application en attente d'ouverture de la boîte de dialogue
    #If VBA6 Then
        PB_AppOldProc = SetWindowsHookEx(WH_CALLWNDPROC, AddressOf AppProc, _
				GetWindowLong(GetForegroundWindow, GWL_HINSTANCE), _
				GetCurrentThreadId())
    #Else
        PB_AppOldProc = SetWindowsHookEx(WH_CALLWNDPROC, AddrOf("AppProc"), _
				GetWindowLong(GetForegroundWindow, GWL_HINSTANCE), _
				GetCurrentThreadId())
    #End If
    ' Appel la boîte de dialogue d'impression standard
    DoCmd.RunCommand acCmdPrint
    ' Stoppe la surveillance des messages
    Call UnhookWindowsHookEx(PB_AppOldProc)
Gestion_Erreurs:
    If Err.Number <> 0 Then MsgBox Err.Description
End Function
 
'---------------------------------------------------------------------------------------
' Remplacement de AddressOf Pour Access 97
'---------------------------------------------------------------------------------------
#If VBA6 Then
#Else
Private Function AddrOf(strFuncName As String) As Long
    Dim hProject As Long
    Dim lngResult As Long
    Dim strID As String
    Dim lpfn As Long
    Dim strFuncNameUnicode As String
 
    Const NO_ERROR = 0
    strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
    Call GetCurrentVbaProject(hProject)
    If hProject <> 0 Then
        lngResult = GetFuncID(hProject, strFuncNameUnicode, strID)
        If lngResult = NO_ERROR Then
            lngResult = GetAddr(hProject, strID, lpfn)
            If lngResult = NO_ERROR Then
                AddrOf = lpfn
            End If
        End If
    End If
End Function
#End If
 
'---------------------------------------------------------------------------------------
' Renvoie la liste des imprimantes séparées par un point-virgule
'---------------------------------------------------------------------------------------
Public Function GetPrinterRowSource() As String
    Dim lReturn As Integer
    Dim lPrinters As String
    Dim lPrinterName As String
    Dim lPos As Integer
    Dim lPort As String
    lPrinters = Space(MAX_SECTION)
    lReturn = GetProfileSection("Devices", lPrinters, MAX_SECTION)
    lPrinters = left(lPrinters, lReturn)
    lPos = 1
    Do
        lPos = InStr(1, lPrinters, "=")
        If lPos = 0 Then Exit Do
        lPrinterName = left(lPrinters, lPos - 1)
        lPos = InStr(1, lPrinters, ",")
        lPrinters = right(lPrinters, Len(lPrinters) - lPos)
        lPos = InStr(1, lPrinters, Chr(0))
        If lPos <> 0 Then
            lPort = left(lPrinters, lPos - 2)
            lPrinters = right(lPrinters, Len(lPrinters) - lPos)
        End If
        GetPrinterRowSource = GetPrinterRowSource & lPrinterName & ";"
    Loop
End Function