2017-01-23 121 views
1

我想開發一個打印系統,用於檢查要打印的每日文檔列表並每小時執行一次。VBA:打印機列表

到目前爲止,我可以打印一個文檔,但是當打印更多的代碼時,代碼僅適用於第一個。

Sub printTag() 

Dim strCommand As String 
Dim filePath As String 
Dim FileName As String 
Dim printer As String 
Dim numRefs As Integer 
Dim x As Integer 
Dim ref As String 
Dim numFiles As Integer 
Dim t As Integer 
Dim difD As Long 
Dim difH As Long 
Dim difM As Long 
Dim listDate As Date 
Dim nowDate As Date 

nowDate = ThisWorkbook.Sheets("Print").Range("B8") 
printer = ThisWorkbook.Sheets("Print").Range("B2") 
numRefs = WorksheetFunction.CountA(ThisWorkbook.Sheets("List").Columns("A")) 
numFiles = WorksheetFunction.CountA(ThisWorkbook.Sheets("Relation").Columns("A")) 

For x = 1 To numRefs 
    On Error Resume Next 
    listDate = ThisWorkbook.Sheets("List").Range("A" & x) 
    difD = DateDiff("d", nowDate, listDate) 
    If difD = 0 Then 
    difH = DateDiff("h", nowDate, listDate) 
    difM = DateDiff("n", nowDate, listDate) 
     If difH = 0 Then 
      If difM >= 0 Then 
       For t = 1 To numFiles 
        If ThisWorkbook.Sheets("List").Range("B" & x) = ThisWorkbook.Sheets("Relation").Range("A" & t) Then 
         filePath = ThisWorkbook.Sheets("Print").Range("B1") & "\" & ThisWorkbook.Sheets("Relation").Range("B" & t) 
         ThisWorkbook.Sheets("Print").Range("B3") = strCommand 
         strCommand = "PRINT " & filePath & "/D:" & printer 
         Shell strCommand, 1 
        End If 
       Next t 
      End If 
     End If 
    End If 
Next x 

End Sub 

回答

0

我想到創建一個腳本,而不是在命令行中發送多個實例,並完美地工作。這是結果:

Sub printTag() 

Dim strCommand As String 
Dim filePath As String 
Dim FileName As String 
Dim printer As String 
Dim numRefs As Integer 
Dim x As Integer 
Dim ref As String 
Dim numFiles As Integer 
Dim t As Integer 
Dim difD As Long 
Dim difH As Long 
Dim difM As Long 
Dim listDate As Date 
Dim nowDate As Date 

nowDate = ThisWorkbook.Sheets("Print").Range("B8") 
printer = ThisWorkbook.Sheets("Print").Range("B2") 
numRefs = WorksheetFunction.CountA(ThisWorkbook.Sheets("List").Columns("A")) 
numFiles = WorksheetFunction.CountA(ThisWorkbook.Sheets("Relation").Columns("A")) 

If Len(Dir$(ThisWorkbook.Path & "\list.bat")) > 0 Then 
    Kill ThisWorkbook.Path & "\list.bat" 
End If 
intFile = FreeFile() 
Open ThisWorkbook.Path & "\list.bat" For Output As #intFile 

For x = 1 To numRefs 
    On Error Resume Next 
    listDate = ThisWorkbook.Sheets("List").Range("A" & x) 
    difD = DateDiff("d", nowDate, listDate) 
    If difD = 0 Then 
    difH = DateDiff("h", nowDate, listDate) 
    difM = DateDiff("n", nowDate, listDate) 
     If difH = 0 Then 
      If difM >= 0 Then 
       For t = 1 To numFiles 
        If ThisWorkbook.Sheets("List").Range("B" & x) = ThisWorkbook.Sheets("Relation").Range("A" & t) Then 
         filePath = ThisWorkbook.Sheets("Print").Range("B1") & "\" & ThisWorkbook.Sheets("Relation").Range("B" & t) 
         Print #intFile, "PRINT " & filePath & " /D:" & printer 
        End If 
       Next t 
      End If 
     End If 
    End If 
Next x 
Print #intFile, "exit" 
Close #intFile 

End Sub