Private Sub btnImport_Click()
'**********************************************************************************
'Variables
Dim Handle As Integer
Dim Start, Length, p, HeaderSize As Long
Dim Tmp, Field, Filename, ConnStr As String
Dim HeaderLines As Long
Dim Point As Integer
Dim i As Integer
Dim db As New ADODB.Connection
Dim rs As New ADODB.Recordset
'set variables*********************************************************************
For i = 0 To FileSelect.ListCount - 1
If (FileSelect.Selected(i) = True) Then Filename = DirSelect.Path & "\" & FileSelect.List(i)
DoEvents
Next i
HeaderLines = 0
HeaderSize = 0
Handle = FreeFile()
If (Filename = "cvsale.src") Then
TableName = "sale" 'change this name
Else
TableName = "changeme"
End If
ConnStr = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Password=admin;Initial Catalog=Everest;Data Source=PC1284"
db.Open (ConnStr)
rs.Open "SELECT * FROM " + Table(0).TableName + ";", db, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockOptimistic
'**********************************************************************************
Open (Filename) For Input As #Handle
'get header info****************************************************************
i = 0
Do While (Not EOF(Handle))
DoEvents
Line Input #Handle, Tmp
If (Left(Tmp, 1) = "%") Then
HeaderLines = HeaderLines + 1
HeaderSize = HeaderSize + Len(Tmp) + 2
Tmp = Mid(Tmp, 2) 'this takes out the '%' character
p = InStr(1, Tmp, " ") 'this reads from 1st char to the 1st 'space'
If (p) Then
'set the header info into variables
CvcallHeader(i).FieldName = Trim(Mid(Tmp, 1, p - 1))
CvcallHeader(i).Offset = Val(Mid(Trim(Mid(Tmp, p)), 1, InStr(1, Trim(Mid(Tmp, p)), " "))) + 1
CvcallHeader(i).Length = Val(Right(Tmp, 3))
End If
i = i + 1
Else
Exit Do
End If
'start getting data from file*******************************************************
Loop
Do While (Not EOF(Handle))
DoEvents
rs.AddNew
rs("TELEPHONE_MEMBER").Value = Mid(Tmp, CvcallHeader(0).Offset, CvcallHeader(0).Length)
rs("TELEPHONE_NUMBER").Value = Mid(Tmp, CvcallHeader(1).Offset, CvcallHeader(1).Length)
rs("MEMBER_NUMBER").Value = Mid(Tmp, CvcallHeader(2).Offset, CvcallHeader(2).Length)
rs("LISTED_NAME").Value = Mid(Tmp, CvcallHeader(4).Offset, CvcallHeader(4).Length)
rs.Update
Line Input #Handle, Tmp
If (EOF(Handle)) Then
rs.AddNew
rs("TELEPHONE_MEMBER").Value = Mid(Tmp, CvcallHeader(0).Offset, CvcallHeader(0).Length)
rs("TELEPHONE_NUMBER").Value = Mid(Tmp, CvcallHeader(1).Offset, CvcallHeader(1).Length)
rs("MEMBER_NUMBER").Value = Mid(Tmp, CvcallHeader(2).Offset, CvcallHeader(2).Length)
rs("LISTED_NAME").Value = Mid(Tmp, CvcallHeader(4).Offset, CvcallHeader(4).Length)
rs.Update
Exit Do
End If
Loop
Close (Handle)
'Debug.Print (Name & vbCrLf & Start & vbCrLf & Length)
End Sub