2017-01-23 84 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