frmimeitexttoaccess.frm

生产数据经常用到文本及数据库方式, 本程序将文本数据转换成数据库, 非常使用

Data1.Recordset.MoveLast
End Sub

Private Sub cmdNext_Click()
Dim iRecordNo As Integer
On Error GoTo Err1
iRecordNo = Data1.Recordset.AbsolutePosition
If iRecordNo < 0 Then Exit Sub

Data1.Recordset.MoveNext
iRecordNo = Data1.Recordset.AbsolutePosition
If iRecordNo < 0 Then
    Data1.Recordset.AddNew
End If
Err1:
End Sub

Private Sub cmdPrevious_Click()
Dim iRecordNo As Integer

On Error GoTo Err2
iRecordNo = Data1.Recordset.AbsolutePosition
If iRecordNo < 0 Then Exit Sub

Data1.Recordset.MovePrevious
iRecordNo = Data1.Recordset.AbsolutePosition
If iRecordNo < 0 Then
    Data1.Recordset.AddNew
End If
Err2:
End Sub

'Private Sub cmdRefresh_Click()
  'this is really only needed for multi user apps
'  Data1.Refresh
'End Sub

Private Sub cmdTextConvertToAccess_Click()
Dim iFile As Integer
Dim sFileLine As String
Dim iLocation As Integer
Dim sIMEITemp As String
Dim sTimeTemp As String
Dim sBoxNoTemp As String
Dim bDataBaseStatus As Boolean

    lRecordCounter = GetNextItemNo
    
    iFile = FreeFile
    Open frmMain.txtIMEISourceName For Input As iFile
    Do While Not EOF(1)
        Line Input #iFile, sFileLine
    '   Debug.Print InputData
        
        iLocation = InStr(sFileLine, "-")
        If iLocation > 0 Then
            'sTimeTemp = sFileLine
            sTimeTemp = Trim(Mid(sFileLine, InStr(sFileLine, "    ") + 1))
            sTimeTemp = Trim(Mid(sTimeTemp, InStr(sTimeTemp, "    ") + 1))
            sBoxNoTemp = "A321+Box" & Format(lRecordCounter \ 20 + 1, "#00000")

            Line Input #iFile, sFileLine
            sIMEITemp = Trim(Left(sFileLine, InStr(sFileLine, "     ")))
            bDataBaseStatus = AddNewRecordset(lRecordCounter, sBoxNoTemp, sIMEITemp, sTimeTemp)
            If bDataBaseStatus = True Then
                lRecordCounter = lRecordCounter + 1
            End If
            sIMEITemp = Trim(Mid(sFileLine, InStr(sFileLine, "     ")))
            sTimeTemp = ""
            bDataBaseStatus = AddNewRecordset(lRecordCounter, Null, sIMEITemp, sTimeTemp)
            If bDataBaseStatus = True Then
                lRecordCounter = lRecordCounter + 1
            End If
        ElseIf IsNumeric(Mid(sFileLine, 1, 1)) = True Then
            sIMEITemp = Trim(Left(sFileLine, InStr(sFileLine, "     ")))
            bDataBaseStatus = AddNewRecordset(lRecordCounter, Null, sIMEITemp, sTimeTemp)
            If bDataBaseStatus = True Then
                lRecordCounter = lRecordCounter + 1
            End If
            
            sIMEITemp = Trim(Mid(sFileLine, InStr(sFileLine, "     ")))
            sTimeTemp = ""
            bDataBaseStatus = AddNewRecordset(lRecordCounter, Null, sIMEITemp, sTimeTemp)
            If bDataBaseStatus = True Then
                lRecordCounter = lRecordCounter + 1
            End If
        End If
    Loop

    Close iFile
End Sub

Private Sub cmdUpdate_Click()

On Error GoTo Err1
    Data1.Recordset.Fields(0).Value = txtItemNo.Text
    Data1.Recordset.Fields(1).Value = txtBoxNo.Text
    Data1.Recordset.Fields(2).Value = txtIMEI.Text
    Data1.Recordset.Fields(3).Value = txtTime.Text

  Data1.UpdateRecord
  Data1.Recordset.Bookmark = Data1.Recordset.LastModified
  Exit Sub
Err1:
    MsgBox "There are IMEI or BoxNo repeattion..."
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub Data1_Error(DataErr As Integer, Response As Integer)
  'This is where you would put error handling code
  'If you want to ignore errors, comment out the next line
  'If you want to trap them, add code here to handle them
  MsgBox "Data error event hit err:" & Error$(DataErr)
  Response = 0  'throw away the error
End Sub

Private Sub Data1_Reposition()
Dim iRecordNo As Integer
    iRecordNo = Data1.Recordset.AbsolutePosition
If iRecordNo >= 0 Then
  'txtItemNo.Text = Data1.Recordset.Fields(0).Value
  If IsNull(Data1.Recordset.Fields(0).Value) Then
    txtItemNo.Text = ""
    
  Else
    txtItemNo.Text = Data1.Recordset.Fields(0).Value
  End If
  If IsNull(Data1.Recordset.Fields(1).Value) Then
    txtBoxNo.Text = ""
    
  Else
    txtBoxNo.Text = Data1.Recordset.Fields(1).Value
  End If
  txtIMEI.Text = Data1.Recordset.Fields(2).Value
  If IsNull(Data1.Recordset.Fields(3).Value) Then
    txtTime.Text = ""
  Else
    txtTime.Text = Data1.Recordset.Fields(3).Value
  End If

Else
  txtItemNo.Text = ""
  txtBoxNo.Text = ""
  txtIMEI.Text = ""
  txtTime.Text = ""
End If


  Screen.MousePointer = vbDefault
  On Error Resume Next
  'This will display the current record position
  'for dynasets and snapshots
  Data1.Caption = "Record: " & (Data1.Recordset.AbsolutePosition + 1)
  'for the table object you must set the index property when
  'the recordset gets created and use the following line
  'Data1.Caption = "Record: " & (Data1.Recordset.RecordCount * (Data1.Recordset.PercentPosition * 0.01)) + 1
End Sub

Private Sub Data1_Validate(Action As Integer, Save As Integer)
  'This is where you put validation code
  'This event gets called when the following actions occur
  Select Case Action
    Case vbDataActionMoveFirst
'        txtCity.Text = Data1.Recordset.Fields(0).Value
'        txtProvince.Text = Data1.Recordset.Fields(1).Value
'        txtPostZone.Text = Data1.Recordset.Fields(2).Value
    Case vbDataActionMovePrevious
    Case vbDataActionMoveNext
    Case vbDataActionMoveLast
    Case vbDataActionAddNew
    Case vbDataActionUpdate
    Case vbDataActionDelete
    Case vbDataActionFind
    Case vbDataActionBookmark
    Case vbDataActionClose
  End Select
  
  
  Screen.MousePointer = vbHourglass
End Sub


Private Sub txtIMEIDatabaseFileName_Click()
Dim sTextFileName As String
Dim i, lTemp As Integer
Dim sTemp, sFileStrTemp As String


With CommonDialog1
        .DialogTitle = "Open"
        .CancelError = False
        .Filter = "MS Access database File (*.mdb)|*.mdb"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sTextFileName = .FileName
End With

    txtIMEIDatabaseFileName.Text = sTextFileName
    
    Data1.DatabaseName = Trim(txtIMEIDatabaseFileName.Text)
    Data1.Enabled = True
    Data1.Refresh

End Sub

Private Sub txtimeisourcename_Click()
Dim sTextFileName As String
Dim i, lTemp As Integer
Dim sTemp, sFileStrTemp As String


With CommonDialog1
        .DialogTitle = "Open"
        .CancelError = False
        .Filter = "Text File (*.txt)|*.txt|Comma Seperated Text File (*.csv)|*.csv"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sTextFileName = .FileName
End With

    txtIMEISourceName.Text = sTextFileName
End Sub

Private Function AddNewRecordset(ByVal lItemNo As Long, ByVal sBoxNo As Variant, ByVal sIMEI As String, ByVal sTime As String) As Boolean
Dim lRecordNo As Long
Dim sErrorMessage As String

On Error GoTo Err1

lRecordNo = Data1.Recordset.AbsolutePosition
If lRecordNo < 0 Then
'No any records exist
    Data1.Recordset.AddNew
Else
    'There are records exist
    Data1.Recordset.MoveLast
    lRecordNo = Data1.Recordset.AbsolutePosition
    If lRecordNo < 0 Then Exit Function

    Data1.Recordset.MoveNext
    lRecordNo = Data1.Recordset.AbsolutePosition
    If lRecordNo < 0 Then
        Data1.Recordset.AddNew
    End If
End If

Data1.Recordset.Fields(0).Value = lItemNo
Data1.Recordset.Fields(1).Value = sBoxNo
Data1.Recordset.Fields(2).Value = sIMEI
Data1.Recordset.Fields(3).Value = sTime

Data1.UpdateRecord
Data1.Recordset.Bookmark = Data1.Recordset.LastModified
AddNewRecordset = True  'Add new recordset normally
Exit Function

Err1:
    sErrorMessage = "There are IMEI or BoxNo repeattion..." & vbCrLf
    sErrorMessage = sErrorMessage & "ItemNo:  " & lItemNo & vbCrLf
    sErrorMessage = sErrorMessage & "Box No:  " & sBoxNo & vbCrLf
    sErrorMessage = sErrorMessage & "IMEI:  " & sIMEI & vbCrLf
    sErrorMessage = sErrorMessage & "Time:  " & sTime & vbCrLf
    
    MsgBox sErrorMessage
    AddNewRecordset = False 'There are some error occured.
End Function

Private Function GetNextItemNo() As Long
Dim lRecordNo As Long

On Error GoTo Err1

lRecordNo = Data1.Recordset.AbsolutePosition
If lRecordNo < 0 Then
'No any records exist
    GetNextItemNo = 1
Else
    'There are records exist
    Data1.Recordset.MoveLast
    GetNextItemNo = CLng(Data1.Recordset.Fields(0).Value) + 1
End If

Exit Function

Err1:
    MsgBox "Can't get the last item No..."
End Function