path/file access error

path/file access error

Post by Del » Wed, 12 Feb 2003 05:40:23



After loading SQL SP3 I now have a user getting
a "path/file access error" on their WinNT wrkstation
whenever they run a word 2000 macro that accesses info on
our SQL 2k server.  Our developer is on vacation and
unreachable so I am not sure where to start looking for
answers.  None of the technet articles had a solution
that seem to fit.
 
 
 

path/file access error

Post by Joel Aske » Wed, 12 Feb 2003 10:04:41


Del:

Can you post the code for the macro and other relevant details?


Quote:> After loading SQL SP3 I now have a user getting
> a "path/file access error" on their WinNT wrkstation
> whenever they run a word 2000 macro that accesses info on
> our SQL 2k server.  Our developer is on vacation and
> unreachable so I am not sure where to start looking for
> answers.  None of the technet articles had a solution
> that seem to fit.


 
 
 

path/file access error

Post by Del » Wed, 19 Feb 2003 22:54:21


Ok here's how I think the process goes:
1.) The user presses a hot key combo which calls an EXE
and passes a command parameter of /PICK
2.) The program opens and prints off a pick list then a
pack list
3.) Then word is suppose to open and print off a Datasheet
or MSDS if it is required. This is when the "Runtime error
75 path/file access error" pops up, before anything prints
off.  The user clicks ok then the program shuts down.

Somewhere in there a text file is written to and read from
that contains the MSDS and Datasheet the is suppose to
print.  The text file is O:\data\work\msdsp.txt.  This
worked fine until SQL SP3 was applied

I have peppered the program with MsgBox's and this is
where the runtime happens -
If Not rstMSDSFile.EOF Then
'write file name
'(MSDS File has a path
'AND msds needs printing)
'OR MSDS is checked
If rstMSDS![european] Then
'Write European MSDS path
Which is in the Public Sub Print_One() routine

Here is the VB Code:
Option Explicit

Public fMainForm As frmMain

Declare Function OpenProcess Lib "kernel32" (ByVal
dwDesiredAccess As Long, ByVal bInheritHandle As Long,
ByVal dwProcessId As Long) As Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal
hHandle As Long, ByVal dwMilliseconds As Long) As Long
Declare Function GetComputerName Lib "kernel32"
Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize
As Long) As Long
Declare Function GetUserName Lib "advapi32.dll"
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As
Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject
As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal
dwMilliseconds As Long)

Global dbcShipInst As ADODB.Connection
Global cnn As ADODB.Connection
Global rst As ADODB.Recordset
Public rsPick As Recordset

Sub Main()

    On Error GoTo EH
    Select Case Trim(LCase(Command))
        Case "/ack":
            DoEvents
            ACK
        Case "/pick":
            DoEvents
            PICK
        Case "/mp":
        'this is used for testing new code
            MP
        Case "":
        'open in edit mode
        'for the order dept.
            frmSplash.Show
            frmSplash.Refresh
            Set dbcShipInst = New ADODB.Connection
            dbcShipInst.Open
("Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=M:\orderdeptdb\shp2inst2k.mdb;Mode=ReadWrite;Persist
 Security Info=False")
            Set fMainForm = New frmMain
            Load fMainForm

            fMainForm.Show
            frmSplash.ZOrder (0)
    End Select
    Exit Sub

EH:
    Call UnexpectedError("Sub_Main", Err.Number,
Err.Description)
    Exit Sub

End Sub

Public Sub ACK()
    Dim x As Integer
    On Error GoTo EH
    'Print acknowledgments
    For x = 1 To HowMany
        frmAckPrint.Show
        frmAckPrint.Refresh
        rptAcknowledgement.PrintReport False
    Next x
    Unload frmAckPrint
    End
EH:
    Call UnexpectedError("ACK", Err.Number,
Err.Description)
    Exit Sub

End Sub

Public Sub PICK()
    On Error GoTo EH
    Set rsPick = New Recordset
    Set cnn = New Connection

    frmPrintSplash.Show
    frmPrintSplash.Refresh

    cnn.ConnectionString =
("Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=M:\orderdeptdb\shp2inst2k.mdb;Mode=Read;Persist
Security Info=False")
    cnn.Open

    'Open Pick ticket record set
    rsPick.CursorLocation = adUseClient
    rsPick.CursorType = adOpenStatic
    rsPick.LockType = adLockReadOnly
    rsPick.ActiveConnection = cnn
    rsPick.Source = "SELECT * from qryOrderPickReport2
order by CO_LN_NO"
    rsPick.Open
    If IsNull(rsPick!carrier) Then
        MsgBox "No carrier has been assigned to this
order. " & vbCrLf & "Please call the Order Dept. and have
them assign a carrier to this order.", vbOKOnly +
vbExclamation, "Carrier Not Assigned"
        Unload frmPrintSplash
        End
    End If
'   Print Pick ticket on Pink form
'   This is the "Color" tray code.
    rptPickList.Printer.PaperBin = 16648
    rptPickList.PrintReport False
    If rsPick!certws Then
        'Print Cert copy to white
        'This is the white tray code
        rptPickList.Printer.PaperBin = 16640
        rptPickList.PrintReport False
    End If

    Call Prt_Rptpack

    'print MSDS & Datasheets
    Print_One
    Unload frmPrintSplash
    End
EH:
    Call UnexpectedError("Pick", Err.Number,
Err.Description)
    Exit Sub

End Sub

Public Sub MP()
    'This is used for testing
    Exit Sub
EH:
    Call UnexpectedError("MP", Err.Number, Err.Description)
    Exit Sub

End Sub

Public Function HowMany() As Integer
    On Error GoTo EH
    'how many acknowledgements?
    HowMany = 1
    HowMany = Val(InputBox("How many Copies?"))
    If HowMany < 1 Then HowMany = 1
    Exit Function

EH:
    Call UnexpectedError("HowMany", Err.Number,
Err.Description)
    Exit Function

End Function

Public Function pickexttext()
    'Gets extended text for pick tickets, packing lists &
acknowledgements
    Dim dbf As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim Key As Long
    Dim Lastrec As Long
    Dim sVal As String
    Dim inCount As Integer
    Dim strQuery As String

    On Error GoTo EH
    sVal = ""
    inCount = 1

    Set dbf = New ADODB.Connection
    Set rst = New ADODB.Recordset
    'open recordset to get text
    dbf.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=M:\Orderdeptdb\shp2inst2k.mdb")
    strQuery = "SELECT DISTINCTROW PICKEXT.CO_NUMBER,
PICKEXT.PAGE_NO, PICKEXT.SEQN_NO, PICKEXT.COHDR_XTXT AS
[Text] " & _
                    "From PICKEXT " & _
                "Where ((Not (PICKEXT.COHDR_XTXT) Is
Null)) " & _
                "ORDER BY PICKEXT.PAGE_NO,
PICKEXT.SEQN_NO;"
    rst.Open strQuery, dbf
    Lastrec = 0
    'count the number of text lines
    Do While Not rst.EOF
        Lastrec = Lastrec + 1
        rst.MoveNext
    Loop
    'if none, then exit function
    If Lastrec < 1 Then
        pickexttext = ""
        Exit Function
    End If

    'return text
    rst.MoveFirst
    While inCount <= Lastrec
        sVal = sVal + Chr(13) + Chr(10) + rst!Text
        inCount = inCount + 1
        rst.MoveNext
    Wend

    pickexttext = sVal
    rst.Close
    Exit Function

EH:
    Call UnexpectedError("Pickexttext", Err.Number,
Err.Description)
    Exit Function

End Function

Public Sub Print_One()
    Dim dbf As ADODB.Connection
    Dim comControl As Command
    Dim comMSDS As Command
    Dim comMSDSFile As Command
    Dim rstControl As ADODB.Recordset
    Dim rstMSDS As ADODB.Recordset
    Dim rstMSDSFile As ADODB.Recordset
    Dim ControlStr As String, MSDSStr As String,
MSDSFileStr As String
    Dim i As Integer, recCount As Integer
    Dim j As Integer, MSDSCount As Integer
    Dim retval As Long, rPointer, tSpec
    Dim tMSDS As String
    Dim lIsWindow As Long
    Dim SearchStr As String
    Dim SearchDAT As String
    Dim strword As String
    Dim oOutlook As Outlook.Application
    Dim fso As FileSystemObject
    Dim fsFolder As Folder, fsTempFolder As Folder
    Dim filQueue As TextStream
    Dim filKey As TextStream

    On Error GoTo EH
    'initialize variables
    ControlStr = "SELECT DISTINCTROW CO_NUMBER, DS, MSDS,
Cust_ID, Ship_to_ID FROM qryOrderPickReport ;"
    MSDSFileStr = "SELECT [item No], MSDSName from
toxtable"

    Set dbf = New ADODB.Connection
    Set comControl = New Command
    Set comMSDS = New Command
    Set comMSDSFile = New Command
    Set rstControl = New ADODB.Recordset
    Set rstMSDSFile = New ADODB.Recordset
    Set rstMSDS = New ADODB.Recordset

    'open DB
    dbf.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=M:\orderdeptdb\shp2inst2k.mdb")

    comControl.ActiveConnection = dbf
    comControl.CommandText = ControlStr
    Set rstControl = comControl.Execute

    comMSDSFile.ActiveConnection = dbf
    comMSDSFile.CommandText = "Select * from toxtable
order by [item no]"
    rstMSDSFile.CursorType = adOpenDynamic
    rstMSDSFile.Source = "Select * from toxtable order by
[item no]"
    rstMSDSFile.ActiveConnection = dbf
    rstMSDSFile.Open
    rstControl.MoveFirst

    ' Find material to send MSDS for
    MSDSStr = "SELECT * FROM pickdet as p1 inner join
(pickhead as p2 inner join tblinstuctions as t1 on t1.vcid
= p2.cust_id and t1.ship_to_id = p2.SHIP_TO_ID) on
p2.co_number = p1.co_number WHERE (LN_STA) = '4' ;"
    comMSDS.ActiveConnection = dbf
    comMSDS.CommandText = MSDSStr
    Set rstMSDS = comMSDS.Execute
    rstMSDS.MoveFirst
    MSDSCount = 0
    Do Until rstMSDS.EOF
        MSDSCount = MSDSCount + 1
        rstMSDS.MoveNext
    Loop
    rstMSDS.MoveFirst
    'set up log files
    Set fso = New FileSystemObject
    Set fsFolder = fso.GetFolder("O:\data\")
    Set fsTempFolder = fso.GetSpecialFolder
(TemporaryFolder)

    Set filKey = fso.OpenTextFile(fsFolder.Path
& "\msdskeys.txt", ForAppending)
    Set filQueue = fso.OpenTextFile(fsTempFolder.Path
& "\msdsp.txt", ForWriting, True)
    filKey.WriteLine "-------------------------------------
----"

    SearchStr = "|"
    SearchDAT = "|"
    For j = 1 To MSDSCount
        'CHECK TO SEE IF IT'S A COMPANY THAT DOES NOT WANT
MSDS OR DATA SHEET
        If Trim(rstMSDS![p1.Cust_ID]) = "FO102" Or Trim
(rstMSDS![p1.Cust_ID] = "ME600") Then
        'Company doesn't want MSDS/DS
        Else
            rPointer = InStr(rstMSDS![Item], " ")
            If rPointer > 0 Then
                tMSDS = Mid(rstMSDS![Item], 1, rPointer -
1)
            Else
                tMSDS = rstMSDS![Item]
            End If
            tSpec = IIf(Right(tMSDS, 1) >= "A" And Right
(tMSDS, 1) <= "Z", Mid(tMSDS, 1, Len(tMSDS) - 1), tMSDS)
            rstMSDSFile.MoveFirst
            rstMSDSFile.Find "[item no] = '" & tMSDS
& "'", , adSearchForward
            If Not rstMSDSFile.EOF Then
                'write file name
                '(MSDS File has a path
                'AND msds needs printing)
                'OR MSDS
...

read more »