' プリンタデバイスドライバの能力を取得する関数の宣言
Private Declare Function DeviceCapabilities Lib "winspool.drv" Alias "DeviceCapabilitiesA"
(ByVal pDevice As String, ByVal pPort As String, ByVal fwCapability As Long,
pOutput As Any, pDevMode As Any) As Long
' ある位置から別の位置にメモリブロックを移動する関数の宣言
Private Declare Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory"
(Destination As Any, Source As Any, ByVal Length As Long)
' DeviceCapabilities function constants.
Private Const DC_PAPERNAMES = 16
Private Const DC_PAPERS = 2
Private Const DC_BINNAMES = 12
Private Const DC_BINS = 6
Private Const DEFAULT_VALUES = 0
'DAOを使っているので
'ツール→参照設定で MicroSoft DAO3.6---にチェックを入れとくこと
Dim db As DAO.Database
Dim rs As DAO.Recordset
Private Sub Form_Load()
Dim strDeviceName As String
Dim strDevicePort As String
Dim lngPaperCount As Long
Dim bytPaper() As Byte
Dim strPaperName As String * 64
Dim lngCounter As Long
Dim aintNubytPaper() As Integer
Dim lngRet As Long
Set db = CurrentDb
Set rs = db.OpenRecordset("T_PaperID")
'ﾃﾞｰﾀ削除
db.Execute "Delete From T_PaperID;"
With Printer
strDeviceName = .DeviceName
strDevicePort = .Port
End With
' 問い合わせる内容を指定
' バッファに必要なサイズを取得
lngPaperCount = DeviceCapabilities(strDeviceName, strDevicePort,
DC_PAPERNAMES, ByVal vbNullString, ByVal vbNullString)
' バッファ確保
ReDim bytPaper(64 - 1, lngPaperCount - 1)
ReDim aintNubytPaper(1 To lngPaperCount)
'用紙名を取得
DeviceCapabilities strDeviceName, strDevicePort, DC_PAPERNAMES, bytPaper(0,
0), ByVal vbNullString
'paper numbers を取得
lngRet = DeviceCapabilities(strDeviceName, strDevicePort, DC_PAPERS,
aintNubytPaper(1), ByVal vbNullString)
'用紙名を列挙
For lngCounter = 0 To lngPaperCount - 1
' 用紙名コピー
MoveMemory ByVal strPaperName, bytPaper(0, lngCounter), 64
' 用紙名追加
'Debug.Print Left(strPaperName, InStr(strPaperName, vbNullChar) - 1) & " " &
aintNubytPaper(lngCounter + 1)
rs.AddNew
rs![ID] = aintNubytPaper(lngCounter + 1)
rs![用紙名] = Left(strPaperName, InStr(strPaperName, vbNullChar) - 1)
rs.Update
Next lngCounter
MsgBox "取得完了"
DoCmd.Close
DoCmd.OpenTable "T_PaperID"
End Sub
|
