DOT NET WORLD

VB 6.0 code for Creating Excel

Firstly Add References:=Microsoft Excel 11.0 Object Library

Dim objExcel As New Excel.Application
Dim oWB As Excel.Workbook
Dim oWS As Excel.Worksheet

Function convertexcel()

Dim line As String
Dim Count As String
h = 2
Dim TextLine As String

Open filename For Input Shared As #1
Do While Not EOF(1) '// Loop until end of file.
Line Input #1, TextLine '// Read line into variable.
' use the TextLine herer...
line = TextLine

Loop
Close #1

'create excel file

Set oWB = objExcel.Workbooks.Add
Set oWS = oWB.Worksheets("Sheet1")

bname = oWB.Name
oWS.Cells.Columns.AutoFit
oWS.Cells.WrapText = False

oWS.Range("A1").Value = "Date"
oWS.Range("B1").Value = "Time"
oWS.Range("C1").Value = "Voltage(ERRU1)"
oWS.Range("D1").Value = "Current(ERRU1)"
oWS.Range("E1").Value = "Voltage(ERRU2)"
oWS.Range("F1").Value = "Current(ERRU2)"
oWS.Range("G1").Value = "Charging Current"
oWS.Range("H1").Value = "Discharging Current"
oWS.Range("I1").Value = "Alternator RPM"

dtlog = Split(line, "FE FF")
For k = 0 To UBound(dtlog) - 1
log = dtlog(k)

If k = 0 Then

Dim dlog() As String
dlog = Split(log, "FF")
log = dlog(1)

End If

datalg = Split(log, " ")
Count = UBound(datalg)

If Count <= 21 Then
If Count >= 18 Then

time = datalg(3) & ":" & datalg(2)
date1 = datalg(4) & "/" & datalg(5) & "/" & datalg(6)

If exdate = "" Then

exdate = date1

Else

exdate = exdate & "," & date1

End If

If extime = "" Then

extime = time

Else

extime = extime & "," & time

End If

If dtr = "" Then

dtr = date1

Else

dtr = dtr + "," + date1

End If

oWS.Range("A" & h).Value = " " & Trim$(Trim$(datalg(4)) & "/" & Trim$(datalg(5)) & "/" & Trim$(datalg(6)))
oWS.Range("B" & h).Value = datalg(3) & ":" & datalg(2)

volt1 = HextoDec(datalg(7) & datalg(8))
vlt1value = Round((volt1 - 511) * 0.495, 2)

If vlt1value < 0 Then

vlt1value = 0

End If

cur1 = HextoDec(datalg(11) & datalg(12))
cr1value = Round((cur1 - 511) * 2.44, 2)

If cr1value < 0 Then

cr1value = 0

End If

volt2 = HextoDec(datalg(9) & datalg(10))
vlt2value = Round((volt2 - 511) * 0.495, 2)

If vlt2value < 0 Then

vlt2value = 0

End If

cur2 = HextoDec(datalg(13) & datalg(14))
cr2value = Round((cur2 - 511) * 2.44, 2)

If cr2value < 0 Then

cr2value = 0

End If

bcur = HextoDec(datalg(15) & datalg(16))
bcrvalue = Round((bcur - 511) * 2.44, 2)
freq1 = HextoDec(datalg(17) & datalg(18))
fr1value = Round((freq1 * 0.79) * 7.5)

If bcrvalue < 0 Then

bcrvalue = 0

End If

If fr1value < 0 Then

fr1value = 0

End If

oWS.Range("C" & h).Value = vlt1value
oWS.Range("D" & h).Value = cr1value
oWS.Range("E" & h).Value = vlt1value
oWS.Range("F" & h).Value = cr2value
oWS.Range("G" & h).Value = bcrvalue
oWS.Range("I" & h).Value = fr1value

h = h + 1

End If
End If
Count = ""

Next k

If Val(Application.Version) < 12 Then
'You use Excel 97-2003

FileExtStr = ".xls": FileFormatNum = -4143

Else
'You use Excel 2007

FileExtStr = ".xls": FileFormatNum = 56

End If
TempFilePath = App.Path

TempFileName = "\Temp\All" & Hour(Now) & "-" & Minute(Now) & "-" & Second(Now)

oWB.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

oWB.close SaveChanges:=True

sfile2 = TempFilePath & TempFileName & FileExtStr

objExcel.Application.Quit

End Function

VB 6.0 code for checking file existing in a folder

Firstly add Reference Microsoft Scripting Runtime

Dim fso As New FileSystemObject

If fso.FileExists(App.Path & "\Excel Files\Default.xls") = False Then

Else

EndIf

VB 6.0 code for read data from a file

Dim line As String

Open filename For Input Shared As #1
Do While Not EOF(1) '// Loop until end of file.
Line Input #1, TextLine '// Read line into variable.
' use the TextLine herer...
line = TextLine

Loop
Close #1

VB 6.0 code for Open file using Microsoft Common Dialog Control 6.0

CommonDialog1.DialogTitle = "Open File"

CommonDialog1.Filter = "Log Documents (*.log)|*.log|Text Documents (*.txt)|*.txt|Excel Spreadsheets (*.xls)|*.xls"

CommonDialog1.FilterIndex = 1

CommonDialog1.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly

CommonDialog1.ShowOpen

Dim filename As string

filename = CommonDialog1.filename

Dim fl As String

fl = CommonDialog1.FileTitle

VB 6.0 code for delete all files in a folder

On Error Resume Next
MkDir App.Path & "\Temp"

DeleteAllFiles App.Path & "\Temp"

Public Function DeleteAllFiles(ByVal FolderSpec As String) As Boolean

Dim oFs As New FileSystemObject
Dim oFolder As Folder
Dim oFile As file

If oFs.FolderExists(FolderSpec) Then
Set oFolder = oFs.GetFolder(FolderSpec)
On Error Resume Next
For Each oFile In oFolder.Files
oFile.Delete True 'setting force to true
'deletes read-only file
Next
DeleteAllFiles = oFolder.Files.Count = 0
End If

End Function

VB 6.0 code for creating folder on runtime

On Error Resume Next
MkDir App.Path & "\Log Files"

Check Tablename in Database using VB 6.0

Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset

Dim tables() as String
Dim tablename as String
Dim msg as String
Dim table1 as String

If con.State = adStateOpen Then
con.Close
End If
con.Open
Set rs = con.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "TABLE"))
Do Until rs.EOF
If table1 = "" Then
table1 = rs!table_name
Else
table1 = table1 & "," & rs!table_name
End If
rs.MoveNext
Loop
rs.Close
Set rs = Nothing

msg = IsInArray(tablename, tables())

Public Function IsInArray(FindValue As Variant, arrSearch As Variant) As Boolean
On Error GoTo LocalError
If Not IsArray(arrSearch) Then Exit Function
If Not IsNumeric(FindValue) Then FindValue = LCase(FindValue)
IsInArray = InStr(1, vbNullChar & Join(arrSearch, vbNullChar) & vbNullChar, _
vbNullChar & FindValue & vbNullChar) > 0
Exit Function
LocalError:
'Justin (just in case)
End Function