TIP: Click on subject to list as thread! ANSI
echo: visual_basic
to: All
from: John
date: 2003-09-03 10:27:00
subject: Help with Code for Word M

Hi I have been trying to work out what is wrong with the following
word macro that someone else wrote and only works on one machine and
as soon as we move to another it fails.. The code is simple. Prints a
document to a .prn file and then converts the .prn file to a .pcx
file. In short the macro runs fine and prints the .prn file but
continually loops on the conversion to the pcx on the
Do Until chrBuffer = &H7E line. Any help is appreciated, I dont know
what I am missing.. Thanks All


Code as follows
________________________________________________________

Option Explicit

Private Const cstrLabelDriver As String = "hp LaserJet 1000"
Private Const cstrLabelsPath As String = "c:\bbs\labels\"

Public Sub sbPublish()

    Dim hfImageFile As Integer
    Dim hfPrintFile As Integer
    Dim strDefPrinter As String
    Dim strProductCode As String
    Dim chrBuffer As Byte, chrTemp As Byte
    Dim intCounter1 As Long, intCounter2 As Long

    strProductCode = InputBox("Enter Product Code", "Publish
Label",
Mid$(ActiveDocument.Name, 1, Len(ActiveDocument.Name) - 4))
    If strProductCode = "" Then Exit Sub

    If Dir(cstrLabelsPath & strProductCode & ".pcx")
 "" Then
        If MsgBox("This label already exists." & vbCrLf &
"Do you want
to replace it?", vbYesNo + vbQuestion + vbDefaultButton2, "Replace
existing label?") = vbYes Then
            If Dir(cstrLabelsPath & strProductCode &
".old")  ""
Then
                Kill cstrLabelsPath & strProductCode & ".old"
            End If
            Name cstrLabelsPath & strProductCode & ".pcx" As
cstrLabelsPath & strProductCode & ".old"
        Else
            Exit Sub
        End If
    End If

    strDefPrinter = Application.ActivePrinter

    Application.ActivePrinter = cstrLabelDriver
    ActiveDocument.PrintOut False, False, wdPrintAllDocument,
cstrLabelsPath & strProductCode & ".prn", , , , , , , True
    Application.ActivePrinter = strDefPrinter

    hfPrintFile = FreeFile
    Open cstrLabelsPath & strProductCode & ".prn" For Binary As
hfPrintFile
    
    hfImageFile = FreeFile
    Open cstrLabelsPath & strProductCode & ".pcx" For Binary As
hfImageFile

    intCounter1 = 0
    intCounter2 = 0

    Get #hfPrintFile, , chrBuffer
'    intCounter1 = intCounter1 + 1
    Do
        Do
            Do
                Do Until chrBuffer = &H7E
                    Get #hfPrintFile, , chrBuffer
'                    intCounter1 = intCounter1 + 1
                Loop
                Get #hfPrintFile, , chrBuffer
'                intCounter1 = intCounter1 + 1
            Loop Until chrBuffer = Asc("I")
            Get #hfPrintFile, , chrBuffer
'            intCounter1 = intCounter1 + 1
        Loop Until chrBuffer = Asc("C")
        Get #hfPrintFile, , chrBuffer
'        intCounter1 = intCounter1 + 1
    Loop Until chrBuffer = Asc("P")

    Do
        Get #hfPrintFile, , chrBuffer
'        intCounter1 = intCounter1 + 1
    Loop Until chrBuffer = 13

    Get #hfPrintFile, , chrBuffer
'    intCounter2 = intCounter2 + 1
    Do
        Do
            Do
                Put #hfImageFile, , chrBuffer
                Get #hfPrintFile, , chrBuffer
'                intCounter2 = intCounter2 + 1
            Loop Until chrBuffer = &H1F
            Put #hfImageFile, , chrBuffer
            Get #hfPrintFile, , chrBuffer
'            intCounter2 = intCounter2 + 1
        Loop Until chrBuffer = 13
        Get #hfPrintFile, , chrBuffer
'        intCounter2 = intCounter2 + 1
        If chrBuffer  &H7E Then
            chrTemp = 13
            Put #hfImageFile, , chrTemp
        End If
    Loop Until chrBuffer = &H7E

    Close hfPrintFile, hfImageFile
    Kill cstrLabelsPath & strProductCode & ".prn"

End Sub
---
þ RIMEGate(tm)/RGXPost V1.14 at BBSWORLD * Info{at}bbsworld.com

---
 * RIMEGate(tm)V10.2áÿ* RelayNet(tm) NNTP Gateway * MoonDog BBS
 * RgateImp.MoonDog.BBS at 9/3/03 10:27:22 AM
* Origin: MoonDog BBS, Brooklyn,NY, 718 692-2498, 1:278/230 (1:278/230)
SEEN-BY: 633/267 270
@PATH: 278/230 10/345 106/1 2000 633/267

SOURCE: echomail via fidonet.ozzmosis.com

Email questions or comments to sysop@ipingthereforeiam.com
All parts of this website painstakingly hand-crafted in the U.S.A.!
IPTIA BBS/MUD/Terminal/Game Server List, © 2025 IPTIA Consulting™.