Doch noch kleines Problem mit .printout

Sub besteinfuegen()
Dim varTextDatei
Dim strPfadAkt As String, rngEinfuegZelle As Range
Dim msg As Integer
Set wksEingang = Worksheets("Wareneingang")
Set wksBestellung = Worksheets("Bestellungen")
strPfadAkt = VBA.CurDir 'Aktives Verzeichnis merken
VBA.ChDir "Macintosh HD:Users:Shared:" 'Verzeichnis mit Textdateien
varTextDatei = Application.GetOpenFilename(Title:="Bitte die soeben erstellte Datei best.txt   _
_
auswählen")
If varTextDatei  False Then
If InStr(1, LCase(varTextDatei), "best") > 0 Then
'Set wksBestellung = Worksheets("Bestellungen")
'Einfügezelle ermitteln
With wksBestellung
If .Cells(.Rows.Count, 1).End(xlUp).Row >= 3 Then
Set rngEinfuegZelle = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
Else
Set rngEinfuegZelle = .Range("A3")
End If
End With
wksBestellung.Activate
'Querrydaten holen
With wksBestellung.QueryTables.Add(Connection:="TEXT;" & varTextDatei, Destination:= _
rngEinfuegZelle)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = True
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlMacintosh
.TextFileStartRow = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 9, 9, 1, 9, 1, 9, 9, 1, 9)
.Refresh BackgroundQuery:=False
End With
Dim objQuerry As QueryTable
'Querries löschen
For Each objQuerry In wksBestellung.QueryTables
objQuerry.Delete
Next
Call spaltenbest
If MsgBox(" " & vbNewLine & "                    Drücken Sie ""Ja"" um einen Drucker  _
auszuwählen !", vbYesNo, "           Soll die Reservierungsliste gedruckt werden?") = vbYes  _
Then
With wksBestellung
'Letzte Datenzelle in Spalte A
Set rngEinfuegZelle = .Cells(.Rows.Count, 1).End(xlUp)
'Druckbereich A1 bis Spalte F letzte Zeile
.PageSetup.PrintArea = .Range(.Cells(1, 1), .Cells(rngEinfuegZelle.Row, 6)).Address
'Drucker auswählen
Application.Dialogs(xlDialogPrint).Show
'.PrintPreview
wksEingang.Activate
.PrintOut ' Diesen macht er ZWEIMAL :(((
End With
Else
wksEingang.Activate
Exit Sub
End If
Else
msg = MsgBox(" " & vbNewLine & "                       Möchten Sie eine andere Datei  _
importieren?", vbYesNo, "  Die Datei ist ungültig und kann nicht importiert werden!")
If msg = vbYes Then
Call besteinfuegen
Else
Exit Sub
End If
End If
End If
VBA.ChDir strPfadAkt 'aktuelles Verzeichnis zurücksetzen
End Sub

Hat jemand eine Idee? hab ich was übersehen?
Nochmals tausend Dank! :(
J.