output to txt file

Option Explicit
 
Private rngXLOrders             As Range 'Range cobvering all order numbers in XL
Private rngOrderFound           As Range 'Range returned from the find function
Private rng                     As Range 'Temporary range object if required
 
 'Change these to reflect your files
Private Const _
strArchiveFilename  As String = "D:\Answers\27325\archive.txt", _
strOutputFilename   As String = "D:\Answers\27325\output-orders.txt"
 
Private intFileIn               As Integer 'File number for input file
Private intFileOut              As Integer 'File number for output file
Private strIn                   As String  'String read from input file and output if reqd
Private strOut                  As String  'String that will be written out
Private bolExportOrder          As Boolean
Private bolOrderinExcel         As Boolean
Private bolExportGroupTotals    As Boolean


 'The following long numbers are used to track the order number and the number of
 'orders read and the number of line read.
Private lngOrder                As Long, _
        lngLastOrder            As Long, _
        lngOrdersFound          As Long, _
        lngOrdersNotFound       As Long, _
        lngLinesRead            As Long, _
        lngOrdersInGroup        As Long
 
Public Sub CheckArchive()
     
     'Set range of order numbers and clear worksheet of previous run data
    Set rngXLOrders = Worksheets("Order_Nmbrs2").Range("A2", Range("A65536").End(xlUp))
    Worksheets("Order_Nmbrs2").Range(Range("B2"), _
                            Range("B2").Offset(rngXLOrders.Rows.Count - 1)).ClearContents
    
'    On Error GoTo DiskError
     'Open input and output files
    intFileIn = FreeFile()
    Open strArchiveFilename For Input As #intFileIn
     
    intFileOut = FreeFile()
    Open strOutputFilename For Output As #intFileOut
     
     'Initialise some counters
    lngLastOrder = -1
    lngOrder = -1
    lngLinesRead = 0
    lngOrdersFound = 0
    lngOrdersNotFound = 0
    bolExportOrder = False
    bolOrderinExcel = False
    'Read the header line
    If Not EOF(intFileIn) Then Line Input #intFileIn, strIn
     
     'Start a loop to read the file until the end
    Do While Not EOF(intFileIn)
        lngLastOrder = lngOrder
        Line Input #intFileIn, strIn
        lngLinesRead = lngLinesRead + 1
        lngOrder = Val(Mid(Trim(strIn), 5, 4))
        If lngOrder = lngLastOrder Then  'Order in current group
            lngOrdersInGroup = lngOrdersInGroup + 1
            If bolExportOrder Then
                Print #intFileOut, strIn
            End If
          Else  'Order is start of a new group
            lngOrdersInGroup = 1
            CheckOrderExportStatus
            If bolExportOrder Then
                lngOrdersFound = lngOrdersFound + 1
                Print #intFileOut, strIn
                rngOrderFound.Offset(0, 1) = "Exported"
            End If
        End If
    Loop
     
     'Close files
    Close #intFileIn
    Close #intFileOut
     
    MsgBox Format(lngLinesRead, "#,##0") & " Lines read" & vbNewLine & _
    Format(lngOrdersFound, "#,##0") & " Orders found" & vbNewLine & _
    Format(lngOrdersNotFound, "#,##0") & " Orders not found", vbOKOnly
     
    On Error GoTo 0
     
    Exit Sub
     
DiskError:
    MsgBox Err.Description, vbCritical + vbOKOnly, "Error in accessing files"
     
End Sub


Private Sub CheckOrderExportStatus()
    Set rngOrderFound = rngXLOrders.Find(lngOrder, , , xlWhole, xlByRows)
    If (rngOrderFound Is Nothing) Then
         'The archived order number is not in the excel file
        lngOrdersNotFound = lngOrdersNotFound + 1
        bolExportOrder = False
        bolOrderinExcel = False
      Else
        'The archived order number is in the excel file
        bolOrderinExcel = True
        'Check to see if it has been exported, if not do it, if it has move on!
        bolExportOrder = (rngOrderFound.Offset(0, 1) <> "Exported")
    End If
End Sub

Option Explicit
 
Private rngXLOrders             As Range 'Range covering all order numbers in XL
Private rngOrderFound           As Range 'Range returned from the find function
Private rng                     As Range 'Temporary range object if required
 
 'Change these to reflect your files
Private Const _
strArchiveFilename  As String = "D:\Answers\27325\archive.txt", _
strArchiveFilename2 As String = "D:\Answers\27325\archive2.txt", _
strOutputFilename   As String = "D:\Answers\27325\output-orders.txt", _
strBatchFilename    As String = "D:\Answers\27325\SortText.bat", _
strSortedFilename   As String = "D:\Answers\27325\SortedArchive.txt"


 
Private intFileIn               As Integer 'File number for input file
Private intFileOut              As Integer 'File number for output file
Private strIn                   As String  'String read from input file and output if reqd
Private strOut                  As String  'String that will be written out
Private bolExportOrder          As Boolean
Private bolOrderinExcel         As Boolean
Private bolExportGroupTotals    As Boolean


 'The following long numbers are used to track the order number and the number of
 'orders read and the number of line read.
Private lngOrder                As Long, _
        lngLastOrder            As Long, _
        lngOrdersFound          As Long, _
        lngOrdersNotFound       As Long, _
        lngLinesRead            As Long, _
        lngOrdersInGroup        As Long


Private strThisLine             As String, _
        strLastLine             As String
 
Private lngLinesIn              As Long, _
        lngLinesOut             As Long, _
        lngLinesDeleted         As Long


Public Sub ProcessArchive()
    SortArchive
    DeDuplicateArchive
    CheckArchive
End Sub


Private Sub SortArchive()
    intFileOut = FreeFile()
    Open strBatchFilename For Output As #intFileOut
    Print #intFileOut, "Sort /r " & strArchiveFilename & " /o " & strSortedFilename
    Close #intFileOut
    ShellAndWait strBatchFilename
End Sub


Private Sub DeDuplicateArchive()
    intFileIn = FreeFile()
    Open strSortedFilename For Input As #intFileIn
    
    intFileOut = FreeFile()
    Open strArchiveFilename2 For Output As #intFileOut
    
    strLastLine = ""
    'Read header line
    Line Input #intFileIn, strThisLine
    lngLinesIn = 0
    lngLinesOut = 0
    lngLinesDeleted = 0
    Do While Not EOF(intFileIn)
        If strLastLine <> strThisLine Then
            Print #intFileOut, strLastLine
            lngLinesOut = lngLinesOut + 1
          Else
            lngLinesDeleted = lngLinesDeleted + 1
        End If
        strLastLine = strThisLine
        Line Input #intFileIn, strThisLine
        lngLinesIn = lngLinesIn + 1
    Loop
    
    Close #intFileIn
    Close #intFileOut
End Sub


Public Sub CheckArchive()
'Set range of order numbers and clear worksheet of previous run data
    Set rngXLOrders = Worksheets("Order_Nmbrs2").Range("A2", Range("A65536").End(xlUp))
    Worksheets("Order_Nmbrs2").Range(Range("B2"), _
                            Range("B2").Offset(rngXLOrders.Rows.Count - 1)).ClearContents
    
'    On Error GoTo DiskError
     'Open input and output files
    intFileIn = FreeFile()
    Open strArchiveFilename2 For Input As #intFileIn
     
    intFileOut = FreeFile()
    Open strOutputFilename For Output As #intFileOut
     
     'Initialise some counters
    lngLastOrder = -1
    lngOrder = -1
    lngLinesRead = 0
    lngOrdersFound = 0
    lngOrdersNotFound = 0
    bolExportOrder = False
    bolOrderinExcel = False
    'Read the header line
    If Not EOF(intFileIn) Then Line Input #intFileIn, strIn
     
     'Start a loop to read the file until the end
    Do While Not EOF(intFileIn)
        lngLastOrder = lngOrder
        Line Input #intFileIn, strIn
        lngLinesRead = lngLinesRead + 1
        lngOrder = Val(Mid(Trim(strIn), 5, 4))
        If lngOrder = lngLastOrder Then  'Order in current group
            lngOrdersInGroup = lngOrdersInGroup + 1
            If bolExportOrder Then
                Print #intFileOut, strIn
            End If
          Else  'Order is start of a new group
            lngOrdersInGroup = 1
            CheckOrderExportStatus
            If bolExportOrder Then
                lngOrdersFound = lngOrdersFound + 1
                Print #intFileOut, strIn
                rngOrderFound.Offset(0, 1) = "Exported"
            End If
        End If
    Loop
     
     'Close files
    Close #intFileIn
    Close #intFileOut
     
    MsgBox "Sorting and deduplication" & vbNewLine & _
           Format(lngLinesIn, "#,##0") & " Lines in original Archive" & vbNewLine & _
           Format(lngLinesOut, "#,##0") & " Written out" & vbNewLine & _
           Format(lngLinesDeleted, "#,##0") & " Deleted" & vbNewLine & _
           "Matching orders" & vbNewLine & _
           Format(lngLinesRead, "#,##0") & " Lines read" & vbNewLine & _
           Format(lngOrdersFound, "#,##0") & " Orders found" & vbNewLine & _
           Format(lngOrdersNotFound, "#,##0") & " Orders not found", vbOKOnly
     
    On Error GoTo 0
     
    Exit Sub
    
     
DiskError:
    MsgBox Err.Description, vbCritical + vbOKOnly, "Error in accessing files"
     
End Sub


Private Sub CheckOrderExportStatus()
    Set rngOrderFound = rngXLOrders.Find(lngOrder, , , xlWhole, xlByRows)
    If (rngOrderFound Is Nothing) Then
         'The archived order number is not in the excel file
        lngOrdersNotFound = lngOrdersNotFound + 1
        bolExportOrder = False
        bolOrderinExcel = False
      Else
        'The archived order number is in the excel file
        bolOrderinExcel = True
        'Check to see if it has been exported, if not do it, if it has move on!
        bolExportOrder = (rngOrderFound.Offset(0, 1) <> "Exported")
    End If
End Sub

Option Explicit


'//The Shell function runs other programs asynchronously so what
'//What you basically have to do is Open the existing Process
'//for the running Application and, LOOP & WAIT for the processes return state
'//ie when the specified process is in the signaled state
'//or a timeout occurs.


Private Declare Function OpenProcess Lib "kernel32" ( _
    ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long
    
Private Declare Function WaitForSingleObject Lib "kernel32" ( _
    ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" ( _
    ByVal hProcess As Long, _
    lpExitCode As Long) As Long


'&HFFFF
Private Const SYNCHRONIZE = &H100000
'// Note:SYNCHRONIZE Windows NT/2000
Private Const INFINITE = &HFFFF 'OR -1&
'// INFINITE, the function’s time-out interval never elapses.
Private Const STILL_ACTIVE = &H103


Public Function ShellAndWait(ByVal BatFile As String)
       '
       ' Shells a new process and waits for it to complete.
       ' Calling application is totally non-responsive while
       ' new process executes.
       '
    Dim PID As Long
    Dim hProcess As Long
    Dim nRet As Long
    
    '// Unlike other Functions Shell generates an error
    '// instead of returning a 0 so handling the error
    '// = Application NOT started.
    On Error Resume Next
    PID = Shell(BatFile, vbMinimizedNoFocus)
    If Err Then
        '// handle the error here and End
        MsgBox "Could NOT execute:= " & BatFile
        End
    End If
    On Error GoTo 0
    
    '// SYNCHRONIZE For Windows NT/2000:
    '// Enables using the process handle in any of the wait
    '// functions to wait for the process to terminate.
    '// obviously with NT you need access rights.
    hProcess = OpenProcess(SYNCHRONIZE, False, PID)
    '// Just set the dwMilliseconds to INFINITE to initiate a Loop
    nRet = WaitForSingleObject(hProcess, INFINITE)
    
    Do
        GetExitCodeProcess hProcess, nRet
        DoEvents
    Loop While nRet = STILL_ACTIVE
    
    CloseHandle hProcess


End Function


Sub OpenFileAndWait()
    Dim sApp As String
    
    '// Define the Application FullPath here
    sApp = "C:\A\Batch.bat"
    'sApp = "C:\windows\system32\calc.exe"
    
    '// Lets DoIt
    ShellAndWait sApp
    '// Tell me if Successful
    MsgBox "Finished running task!"
End Sub