Sandarddrucker wechseln unter Acc97

28/06/2012 - 09:31 von Hubert Holler | Report spam
Ich verwende eine MS-Access97 Anwendung, wo ich per VBA den
Standarddrucker wechsle.
Das ganze funktioniert auch recht gut. Nur bei einigen Rechnern kommt es
plötzlich nach einiger Zeit vor, dass beim Wechseln sich die Access
Anwendung aufhàngt. Das Programm hàngt sich in folgender Zeile auf:
SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows") (siehe Code
unten)
Sonst funktioniert es immer einwandfrei.

Hier der Code:
-

Public Const HWND_BROADCAST = &HFFFF
Public Const WM_WININICHANGE = &H1A

Public Function drucker_standard_neu(Druck As String)

Dim osinfo As OSVERSIONINFO
Dim retValue As Integer
Dim X As String
Dim R As Long

osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retValue = GetVersionExA(osinfo)

If osinfo.dwMajorVersion = 3 And osinfo.dwMinorVersion = 51 And _
osinfo.dwPlatformId = 2 Then
Call WinNTSetDefaultPrinter(Druck)
X = GetProfile("win.ini", "Windows", "Device")

R = InStr(1, X, ",")
If R > 0 Then
X = Left(X, R - 1)
End If

drucker_standard_neu = X
ElseIf osinfo.dwMajorVersion = 4 _
And osinfo.dwPlatformId = 1 Then
Call Win95SetDefaultPrinter(Druck)
X = GetProfile("win.ini", "Windows", "Device")

R = InStr(1, X, ",")
If R > 0 Then
X = Left(X, R - 1)
End If

drucker_standard_neu = X
ElseIf osinfo.dwMajorVersion = 4 And osinfo.dwMinorVersion = 0 _
And osinfo.dwPlatformId = 2 Then
Call WinNTSetDefaultPrinter(Druck)
X = GetProfile("win.ini", "Windows", "Device")

R = InStr(1, X, ",")
If R > 0 Then
X = Left(X, R - 1)
End If

drucker_standard_neu = X
ElseIf osinfo.dwMajorVersion = 5 And osinfo.dwMinorVersion = 0 _
And osinfo.dwPlatformId = 2 Then
Call WinNTSetDefaultPrinter(Druck)
X = GetProfile("win.ini", "Windows", "Device")

R = InStr(1, X, ",")
If R > 0 Then
X = Left(X, R - 1)
End If

drucker_standard_neu = X
ElseIf osinfo.dwMajorVersion = 5 And osinfo.dwMinorVersion = 1 _
And osinfo.dwPlatformId = 2 Then
Call WinNTSetDefaultPrinter(Druck)
X = GetProfile("win.ini", "Windows", "Device")

R = InStr(1, X, ",")
If R > 0 Then
X = Left(X, R - 1)
End If

drucker_standard_neu = X
End If
End Function

Private Sub WinNTSetDefaultPrinter(Druckername As String)
Dim Buffer As String
Dim DeviceName As String
Dim DriverName As String
Dim PrinterPort As String
Dim PrinterName As String
Dim R As Long
'If List1.ListIndex > -1 Then
If Len(Nz(Druckername)) > 0 Then

'Druckerinformationen des aktuellen Standarddruckers
'aus der WIN.INI bestimmen
Buffer = Space(1024)
' PrinterName = List1.Text
PrinterName = Druckername
R = GetProfileString("PrinterPorts", PrinterName, "", _
Buffer, Len(Buffer))

'Treibernamen und Anschluß aus Puffer parsen
GetDriverAndPort Buffer, DriverName, PrinterPort

If DriverName <> "" And PrinterPort <> "" Then
SetDefaultPrinter Druckername, DriverName, PrinterPort
End If
End If
End Sub


Private Sub SetDefaultPrinter(ByVal PrinterName As String, _
ByVal DriverName As String, ByVal PrinterPort As String)
Dim DeviceLine As String
Dim R As Long
Dim L As Long
DeviceLine = PrinterName & "," & DriverName & "," & PrinterPort
' Neue Drucker Informationen im [WINDOWS] Abschnitt der WIN.INI speichern
R = WriteProfileString("windows", "Device", DeviceLine)
' Alle Applikationen müssen die WIN.INI neu einlesen:
L = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows")
End Sub


Hoffe ich habe keine Codezeilen vergessen und da kann mir jemand einen
Tip geben wo der Fehler liegen könnte bzw. was ich kontrollieren könnte.
Vielen Dank für jede Antwort
 

Lesen sie die antworten

#1 Hubert Holler
28/06/2012 - 15:37 | Warnen spam
Wir haben nun festgestellt, wo die Ursache liegt.
Auf den Rechnern sind immer 2 verschiedene Office Versionen insalliert.
1x Office 97 für Access und Office 2000 bzw. 2003 für Word, Excel,
Powerpoint und Outlook.

Sobald Outlook gestartet ist hàngt sich Access auf, sobald man aber
Outlook wieder schließt wird der Ausdruck ohne Probleme ausgeführt bzw.
weitergeführt. D.h. Wenn man Outlook 2000 oder 2003 gestartet hat und
die Acc97 Anwendung und man druckt in Access und ruft die Funktion
(Standarddrucker wechseln auf) bleibt der Code in der Zeile
SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows") stehen. Wenn
man aber Outlook schließt funktioniert alles wieder ohne Probleme.

Hoffe da kann mir jemand weiterhelfen, wie ich diesesn Fehler beheben
könnte, so dass man beide Programme (Outlook und Access) geöffnet lassen
kann.

Vielen Dank für jede Antwort

Ähnliche fragen