Untitled

mail@pastecode.io avatar
unknown
plain_text
2 months ago
2.6 kB
1
Indexable
Never
Private Sub Command2_Click()
    Dim Amtd As String * 8
    Dim Myamt As Double

    Myamt = 0

    tblname = "Reture Batches"
     tblnameE = "Reture EBatches"
      Filename_out = Me.Text2.Text & "\EDL_Returned.txt"
    Set rstStreamOut = CreateObject("ADODB.Stream")

    Set rst = New ADODB.Recordset
       Set rstE = New ADODB.Recordset
    Set rstConn = New ADODB.Connection


    With rstStreamOut
        .Charset = "utf-8"
        .Type = 2 ' adTypeText
        .Open
        .LoadFromFile Filename_in
        .LineSeparator = 10
    Do Until rstStreamOut.EOS
    Sline = .ReadText(-2)
    FileNumber = FreeFile

    'Open Filename_in For Input As #FileNumber
    'Do While Not EOF(FileNumber)
        'Line Input #FileNumber, Sline

        If UCase(Me.compcode) = UCase("EDL") Then
            telno = Mid(Sline, 70, 5)
            Amtd = Mid(Sline, 75, 10)
            'Myamt = Val(Mid(Sline, 77, 12)) / 100
            Myamt = Val(Mid(Sline, 75, 10))

            OpenConnection
            sSQL = "SELECT * FROM [" & tblname & "] WHERE [Company code] = '" & Me.compcode & "'" & _
            " AND [Tel No] = '" & telno & "' AND [Amount] = " & Myamt


   sSQLE = "SELECT * FROM [" & tblnameE & "] WHERE [Company code] = '" & Me.compcode & "'" & _
            " AND [Tel No] = '" & telno & "' AND [Amount] = " & Myamt

  rstE.Open sSQLE, dbs, adOpenDynamic, adLockOptimistic
            rst.Open sSQL, dbs, adOpenDynamic, adLockOptimistic
            If Not rst.EOF And rstE.EOF Then
                FileNumber1 = FreeFile
                Open Filename_out For Append As #FileNumber1
                Do Until rst.EOF
                    If telno = rst![Tel No] Then
                        Print #FileNumber1, Sline
                    End If
                    rst.Delete
                    rst.MoveNext
                Loop

                Close #FileNumber1
            End If
            rst.Close
             rstE.Close
        End If
    Loop
   ' Close #FileNumber
End With
    'Set rst = Nothing
    Set dbs = Nothing

    'On Error Resume Next
    'MkDir App.Path & "\Returndone"
    'MkDir App.Path & "\ToCompany"
    'j = InStrRev(Filename_in, "\", -1, vbTextCompare)
    'FileCopy Filename_in, App.Path & "\Returndone\" & Mid(Filename_in, j + 1)
    'j = InStrRev(Filename_out, "\", -1, vbTextCompare)
    'FileCopy Filename_out, App.Path & "\ToCompany\" & Mid(Filename_out, j + 1)
    'rstStreamOut.SaveToFile Filename_out, 2 ' adSaveCreateOverWrite
    rstStreamOut.Close
    Kill Filename_in
    ' Kill Filename_out
End Sub
Leave a Comment