none
Can I Verify That A File Has Been Written To Share? RRS feed

  • Question

  • I am a novice VBA user here but I've been fairly successful in troubleshooting some minor issues. Need a little assistance here.

    We have a Subroutine that throws data into a CSV. It generally works but lately, the shop calls to say they didn't get the file. It is a Macro called RELEASE TO SHOP and it generate a file on a network share. Each time I get a call on this, when I test it and monitor it, it always works. And when it does work, a message next to the macro button appears called RELEASED. If it has to be released again, they get the message AGAIN.

    I am thinking this is either a network hiccup at the time of the release or something minor. The users of the file really don't have a reason to delete the file. They NEED it, so I really don't think that is it.

    I am wondering if I need some kind of verifier code to make sure the file is there. Any tips on how to come up with code that will do that?

    Below is the Subroutine (with some edits to protect privacy):

    Sub Export_Purlin(wksName As String)
        Application.ScreenUpdating = False
        Dim strWrkSheet As String
        Dim sJobNum As String
        Dim sCustomer As String
        Dim sOut As String
        Dim fh As Long
        Dim i As Integer, iu As Integer
        Dim j As Integer
        Dim l As Integer
        Dim intRowLast As Integer
        Dim strBNum As String

    'Bundle printer
    'JobNumber,CustomerName,LineID,RequestedQty,CoilPartNum,Length,Profile,Color,PieceMark,Description,BundleMark,Weight,PatternName,HoleType XOffset YOffset|HoleType XOffset YOffset|(up to 191 punches per part)
        Workbooks(wksName).Activate
        If ConfirmWeights("Purlin") = False Then Exit Sub
        If ValidateHoles = False Then Exit Sub
        AddNotesToPurlinGirt
        strWrkSheet = ActiveSheet.Name
        PrepareImportPage4Purlin (wksName)
    '****************************************************
    'Stop 'For Debugging Prep code! Rem when not in use.*
    '****************************************************
        fh = FreeFile
        Sheets("IMPORT").Select
        sJobNum = Workbooks(wksName).Worksheets("PURLIN GIRT").Cells(2, 5).Value
        If Val(Left$(sJobNum, 1)) = 0 Then
          sJobNum = Format$(Now(), "yy") & sJobNum
         ElseIf Left$(sJobNum, 1) > 6 Then
          sJobNum = "0" & sJobNum
        End If
        If InStr(sJobNum, ",") <> 0 Then sJobNum = Replace(sJobNum, ",", "")
    '    Open "\\PCNAME\Purlin$\" & sJobNum & "-Purlin.csv" For Output As #fh '<-- Original
    '    Open "C:\" & sJobNum & "-Purlin.csv" For Output As #fh '<-- Testing
        Open "\\SERVER IP Address\Bradbury-Xfer\Purlin\" & sJobNum & "-Purlin.csv" For Output As #fh '<-- Production
    '    sOut = "JobNumber,CustomerName,LineID,RequestedQty,CoilPartNum,Length,Profile,Color,PieceMark,BundleMark,Weight,PatternName,HoleType XOffset YOffset|HoleType XOffset YOffset|(up to 191 punches per part)"
    'Bundle Printer
        sOut = "JobNumber,CustomerName,LineID,RequestedQty,CoilPartNum,Length,Profile,Color,PieceMark,Description,BundleMark,Weight,PatternName,HoleType XOffset YOffset|HoleType XOffset YOffset|(up to 191 punches per part)"
        Print #fh, sOut ' Header
        sCustomer = Replace(Workbooks(wksName).Worksheets("PURLIN GIRT").Cells(3, 5).Value, ",", "")
        sOut = sJobNum & "," & sCustomer
        l = 51

        ActiveSheet.Range("A65536").End(xlUp).Select
        intRowLast = Int(Right(ActiveCell.Address, Len(ActiveCell.Address) - 3))

        For j = 1 To intRowLast
            If InStr(Cells(j, 9).Value, "&") = 0 Then
                If Val(Cells(j, 1).Value) <> 0 Then
                    sOut = sOut & ",PURLIN"                            ' LineID
                    sOut = sOut & ("," & Cells(j, 1).Value)            ' Part quantity
                    sOut = sOut & ("," & Cells(j, 10).Value)           ' Coil Part Number
                    sOut = sOut & ("," & CInches(Cells(j, 6).Value))   ' Length in inches (decimal)
                    sOut = sOut & ("," & Cells(j, 4).Value)            ' Profile
                    sOut = sOut & ("," & Left$(Cells(j, 5).Value, 15)) ' Color
                    sOut = sOut & ("," & Cells(j, 2).Value)            ' Piece mark
    'Bundle Printer
                    sOut = sOut & ("," & Cells(j, 3).Value)            ' Description

                    strBNum = Cells(j, 23).Value
                    Do While Len(strBNum) < 3
                        strBNum = "0" & strBNum
                    Loop
                    sOut = sOut & "," & strBNum                        ' Bundle mark
                    l = l + 1
                    sOut = sOut & ("," & Cells(j, 7).Value)            ' Weight (total)
                    sOut = sOut & ("," & Cells(j, 9).Value)            ' Pattern Name
                    sOut = sOut & ("," & Cells(j, 11).Value)           ' Holes
                    Print #fh, sOut
                    sOut = ","
                End If
            End If
        Next j
        ActiveSheet.UsedRange.ClearContents
        Sheets(strWrkSheet).Select
        Range("K10").Select
        If Range("K10").Value = "" Then
            With Selection
                .HorizontalAlignment = xlRight
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
                .Value = "Released"
            End With
            With Selection.Interior
                .ColorIndex = 4
                .Pattern = xlSolid
            End With
        Else
            With Selection
                .HorizontalAlignment = xlRight
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
                .Value = "Again"
            End With
            With Selection.Interior
                .ColorIndex = 50
                .Pattern = xlSolid
            End With
        End If
        Sheets("IMPORT").Visible = False
        Close #fh
        Application.ScreenUpdating = True
        Application.ScreenUpdating = True
    End Sub

    Tuesday, November 27, 2012 3:51 PM

Answers

  • Something like this after your Close #fh line (using the file path and name from your <=Production line):

    Dim strFile As String
    strFile = Dir("\\SERVER IP Address\Bradbury-Xfer\Purlin\" & sJobNum & "-Purlin.csv")

    If strFile <> "" Then
    MsgBox "The new file exists."
    Else
    MsgBox "The new file is not found."

    Goto RedoFile:  'Create the label RedoFile: at the top of your macro

    End If


    Tuesday, November 27, 2012 4:47 PM

All replies

  • Something like this after your Close #fh line (using the file path and name from your <=Production line):

    Dim strFile As String
    strFile = Dir("\\SERVER IP Address\Bradbury-Xfer\Purlin\" & sJobNum & "-Purlin.csv")

    If strFile <> "" Then
    MsgBox "The new file exists."
    Else
    MsgBox "The new file is not found."

    Goto RedoFile:  'Create the label RedoFile: at the top of your macro

    End If


    Tuesday, November 27, 2012 4:47 PM
  • Somthing like this, using the file path and name from your <=Production line:

    Dim strFile As String
    strFile = Dir("\\SERVER IP Address\Bradbury-Xfer\Purlin\" & sJobNum & "-Purlin.csv")

    If strFile <> "" Then
    MsgBox "The new file exists."
    Else
    MsgBox "The new file is not found."
    End If


    Thanks...about to try it...
    Tuesday, November 27, 2012 8:22 PM
  • Somthing like this, using the file path and name from your <=Production line:

    Dim strFile As String
    strFile = Dir("\\SERVER IP Address\Bradbury-Xfer\Purlin\" & sJobNum & "-Purlin.csv")

    If strFile <> "" Then
    MsgBox "The new file exists."
    Else
    MsgBox "The new file is not found."
    End If

    It works for confirmation of the file. Since this is a random event, we will see if it works for when it doesn't arrive.

    Thanks again!
    Tuesday, November 27, 2012 10:00 PM