This codes was from vb5 and im trying to replace/update it to vb.net, i
just need expert's feedback on this before i start changing stuff coz im
not that good im just a newbie!
Private Sub SSCommand2_Click()
Dim SourceChan As Integer
Dim DestinChan As Integer
Dim FileLen As Long
Dim SourceSP As Long
Dim NewSourceSP As Long
Dim SourceEP As Long
Dim DestinSP As Long
Dim NewDestinSP As Long
Dim DestinEP As Long
Dim SourceLen As Long
Dim DestinLen As Long
Dim FindChar As String
Dim CombinedFile As String
Dim Header As String
Dim LabelCount As Long
Dim LineCount As Long
Dim char As Byte
Dim CustomLBL As Boolean
Dim SigID As Integer
CustomLBL = False
msg = "The Source File will be Appended to the End of" _
& Chr(13) & Chr(10) & "the Current Job File, OK"
Style = vbYesNo + vbInformation + vbDefaultButton2
Title = "Append to Job File"
response = MsgBox(msg, Style, Title)
If response = vbYes Then
GoTo BeginAppend
Else
GoTo ExitAppend
End If
BeginAppend:
Screen.MousePointer = 11
'<>
'<> see if source file has a header (file to be appended)
'<>
SourceChan = FreeFile
Open FileName1 For Binary As SourceChan
SourceLen = LOF(SourceChan)
SourceFile = String(SourceLen, 0)
Get #SourceChan, , SourceFile
Close #SourceChan
SourceSP = 1
FindChar = "<eoh>"
If Left(SourceFile, 4) = "@fmt" Then
SourceSP = InStr(SourceFile, FindChar)
SourceSP = SourceSP + 6 ' <eoh> + crlf
' see if custom format
FindChar = ".sig"
SigID = InStr(SourceFile, FindChar)
If SigID > 0 Then
If Mid(SourceFile, SigID - 3, 1) = "5" Then
CustomLBL = True
SLBLLineCount = 5
Else
CustomLBL = False
SLBLLineCount = 4
End If
End If
End If
'<>
'<> no append allowed on a custom label format, new run only
'<>
If CustomLBL = True Then
msg = "The Source is a Custom Format, you can not " _
& Chr(13) & Chr(10) & "Append this type, use 'New Run' button, OK"
Style = vbOKOnly + vbInformation
Title = "Append to Job File"
response = MsgBox(msg, Style, Title)
GoTo ExitAppend
End If
If SourceSP > 1 Then
NewSourceSP = SourceSP + 1 ' first position after crlf
Header = Left(SourceFile, SourceSP)
Else
NewSourceSP = 1
Header = ""
End If
FindChar = vbLf
SourceSP = Len(SourceFile)
If Right(SourceFile, 1) <> FindChar Then
Do Until InStr(SourceSP, SourceFile, FindChar) > 0
SourceSP = SourceSP - 1
Loop
End If
SourceEP = SourceSP
DestinChan = FreeFile
Open FileName2 For Binary As DestinChan
DestinLen = LOF(DestinChan)
DestinFile = String$(DestinLen, 0)
Get #DestinChan, , DestinFile
Close #DestinChan
FindChar = vbLf
DestinSP = Len(DestinFile)
If Right(DestinFile, 1) <> FindChar Then
Do Until InStr(DestinSP, DestinFile, FindChar) > 0
DestinSP = DestinSP - 1
Loop
End If
DestinEP = DestinSP
CombinedFile = Left(DestinFile, DestinEP)
CombinedFile = CombinedFile + Mid(SourceFile, NewSourceSP, (SourceEP
- NewSourceSP))
Open FileName2 For Output As DestinChan
Print #DestinChan, CombinedFile
Close #DestinChan
char = Asc(vbLf)
LblCount = 0
LineCount = 0
LineCount = DxFileLineCount(FileName2, char)
LblCount = Int(LineCount / SLBLLineCount)
Label7.Caption = Str(LblCount)
Label7.Refresh
SourceFile = FileName1
DestinFile = SourceFilePath(3) + Format(Now, "MMM") + "\" +
File1.FileName
On Error GoTo DestNotFound
Open DestinFile For Input As #25
If LOF(25) > 0 Then
Close #25
GoTo AllreadyE
End If
DestNotFound:
On Error GoTo 0
FileCopy SourceFile, DestinFile
GoTo ContNoError
AllreadyE:
Screen.MousePointer = 0
On Error GoTo 0
msg = "The Archive Backup File Already Exists " _
+ Chr(13) + Chr(10) + "Replace?"
Style = vbYesNo + vbInformation + vbDefaultButton2
Title = "Archive Source File"
response = MsgBox(msg, Style, Title)
If response = vbYes Then
FileCopy SourceFile, DestinFile
End If
ContNoError:
Kill SourceFile
File1.Pattern = "*.xyz"
File1.Pattern = Text1.Text
DoEvents
msg = "New Bar Code Job File is Complete"
Style = vbOKOnly + vbInformation
Title = "New Run Appended"
response = MsgBox(msg, Style, Title)
SSCommand1.Enabled = False
SSCommand2.Enabled = False
SSCommand5.Enabled = False
SSCommand6.Enabled = False
Label1.Caption = ""
Label3.Caption = ""
ExitAppend:
Screen.MousePointer = 0
End Sub
*** Sent via Developersdex http://www.developersdex.com ***
