VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   855
      Left            =   720
      TabIndex        =   0
      Top             =   840
      Width           =   1815
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
 Option Explicit
 
  '打開一個主鍵
  Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
 ( _
     ByVal hKey As Long, _
     ByVal lpSubKey As String, _
     ByRef phkResult As Long _
 ) As Long
     
 '關閉一個主鍵
  Public Declare Function RegCloseKey Lib "advapi32.dll" _
 ( _
     ByVal hKey As Long _
 ) As Long
     
 '創建或改變一個鍵值,lpData應由缺省的ByRef型改為ByVal型
  Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
 ( _
     ByVal hKey As Long, _
     ByVal lpValueName As String, _
     ByVal Reserved As Long, _
     ByVal dwType As Long, _
     ByVal lpData As Any, _
     ByVal cbData As Long _
 ) As Long
     
 '查詢一個鍵值,lpData應由缺省的ByRef型改為ByVal型
  Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
 ( _
     ByVal hKey As Long, _
     ByVal lpValueName As String, _
     ByVal lpReserved As Long, _
     ByRef lpType As Long, _
     ByVal lpData As Any, _
     ByRef lpcbData As Long _
 ) As Long
 
 '根鍵常數
 Const HKEY_CLASSES_ROOT = -2147483648#
 Const HKEY_CURRENT_USER = -2147483647#
 Const HKEY_LOCAL_MACHINE = -2147483646#
 Const HKEY_USERS = -2147483645#
     
 '鍵值類型
 Const REG_SZ = 1&             '字符串值
 Const REG_BINARY = 3&         '二進制值
 Const REG_DWORD = 4&          'DWORD值
 
 
 '通過修改注冊表修改默認打印機
 'win2000,winXP: HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows
 
  Public Sub SetDefaultPrinter(ByVal sPrinter As String)
     
     Dim nKeyHandle As Long, nValueType  As Long, nLength As Long
     Dim sValue As String
     
     Dim p As Printer
     For Each p In Printers
         If p.DeviceName = sPrinter Then
             sValue = p.DeviceName & "," & p.DriverName & "," & p.Port
             Exit For
         End I
     Next
     Set p = Nothing
 
     nValueType = REG_SZ
     nLength = 255
 
     Call RegOpenKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows", nKeyHandle)
     '修改Device這個值
     Call RegSetValueEx(nKeyHandle, "Device", 0, nValueType, sValue, nLength)
     '查詢Device這個值
     'sValue = Space(255)
     'Call RegQueryValueEx(nKeyHandle, "Device", 0, nValueType, sValue, nLength)
     'MsgBox sValue
     Call RegCloseKey(nKeyHandle)
        
 End Sub
 
 'DataReport中的代碼：
 '指定DataReport打印機
  Private Sub DataReport_Initialize()
     Call SetDefaultPrinter("\\PC1EPSON LQ-680K ESC/P 2")
 End Sub
 
 '完成報表打印后還原原有默認打印機,原有默認打印機可以由RegQueryValueEx獲得
  Private Sub DataReport_QueryClose(Cancel As Integer, CloseMode As Integer)
     Call SetDefaultPrinter("\\Pc8Legend LJ6112MFC")
     End
 End Sub
 
以上代碼 VB6 SP6 + Windows XP SP2 下通過
另外，更改默認打印機還可以用以下方法解決：
 
 Option Explicit
 
 Private Const HWND_BROADCAST As Long = &HFFFF&
 Private Const WM_WININICHANGE As Long = &H1A
 
  Private Declare Function SendNotifyMessage Lib "user32" Alias "SendNotifyMessageA" ( _
     ByVal hwnd As Long, _
     ByVal msg As Long, _
     ByVal wParam As Long, _
     lParam As Any _
 ) As Long
    
  Private Declare Function SetDefaultPrinter Lib "winspool.drv" Alias "SetDefaultPrinterA" ( _
    ByVal pszPrinter As String _
 ) As Long
 
  Private Sub Command1_Click()
     
     '直接更改默認打印機
     Call SetDefaultPrinter(Trim(CmbPrinter.Text))
     '通知更改
     Call SendNotifyMessage(HWND_BROADCAST, _
                           WM_WININICHANGE, _
                           0, ByVal "windows")
     
 End Sub
 
  Private Sub Form_Load()
     Dim p As Printer
     For Each p In Printers
         CmbPrinter.AddItem p.DeviceName
     Next
 End Sub