quote:

Postado originalmente por Vinho:
Antes de tudo defina essas estruturas abaixo em um módulo global :

Type zwtDevNamesStr2
rgb As String * 100
End Type

Type zwtDevNames2
DriverOffSet As Integer
DeviceOffSet As Integer
OutputOffSet As Integer
DEFAULT As Integer
End Type


Type zwtDevModeStr2
rgb As String * 68
End Type

Type zwtDevMode2
dmDeviceName As String * 64
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmResolution As Integer
dmTTOption As Integer
End Type

No módulo form_open do formulário em que o usuário irá digitar os dados que servirão de filtro para o relatório escreva a instrução
Docmd runmacro "Configurar Impressora", irá aparecer a caixa de escolha com as impressoras instaladas.

No botão ok desse formulário escreva a instrução

PortaImpressora = ObtemPortaImpressora(Me.name)
Open PortaImpressora For Output As #1

e finalmente a função que pega a porta é a seguinte :

Function ObtemPortaImpressora (NomeFormulário)

Dim dmName As zwtDevNamesStr2, ModoDispName As zwtDevNames2
Dim dmMode As zwtDevModeStr2, ModoDispMode As zwtDevMode2
Dim porta As String, REL As String, i As Integer

If Not IsNull(Forms(NomeFormulário).PrtDevNames) Then
dmName.rgb = Forms(NomeFormulário).PrtDevNames
dmMode.rgb = Forms(NomeFormulário).PrtDevMode
LSet ModoDispName = dmName
LSet ModoDispMode = dmMode
For i = 1 To 100
If Asc(Mid(dmName.rgb, ModoDispName.OutputOffSet + i, 1)) <> 0 Then
porta = Mid(dmName.rgb, ModoDispName.OutputOffSet + 1, i)
Else
i = 200
End If
Next i
If Right(porta, 1) = ":" Then
porta = Left(porta, Len(porta) - 1)
End If
porta = CStr(porta)
If IsNull(porta) Or IsEmpty(porta) Or porta = "" Then
MsgBox "Não foi possível capturar a porta da impressora !"
End If
Else
MsgBox "Não foi possível obter a porta da impressora, será fornecido LPT1 como padrão !"
ObtemPortaImpressora = "LPT1"
Exit Function
End If

ObtemPortaImpressora = porta

End Function

Compartilhe o que você sabe, todos saem ganhando.