frmginwaveimei-nettoaccess.frm

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

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 sSNTemp As String
'Dim sLicenceTemp As String
Dim bDataBaseStatus As Boolean

    LstInValidMessages.Clear

    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 = "A323Box" & 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
        If IsNumeric(Mid(sFileLine, 1, 1)) = True Then
            sLicenceTemp = Trim(Left(sFileLine, InStr(sFileLine, "  ")))
            sFileLine = Trim(Mid(sFileLine, InStr(sFileLine, " ") + 1))
            sIMEITemp = Trim(Left(sFileLine, InStr(sFileLine, " ")))
            sSNTemp = Trim(Mid(sFileLine, InStr(sFileLine, " ") + 1))
            bDataBaseStatus = AddNewRecordset(lRecordCounter, sLicenceTemp, sIMEITemp, sSNTemp)
            If bDataBaseStatus = True Then
                lRecordCounter = lRecordCounter + 1
            Else
                LstInValidMessages.AddItem "There are IMEI or BoxNo repeattion..." & vbCrLf
                LstInValidMessages.AddItem "ItemNo:  " & lRecordCounter & vbCrLf
                LstInValidMessages.AddItem "Licence:  " & sLicenceTemp & vbCrLf
                LstInValidMessages.AddItem "IMEI:  " & sIMEITemp & vbCrLf
                LstInValidMessages.AddItem "SN:  " & sSNTemp & vbCrLf
                LstInValidMessages.AddItem vbCrLf
                
                If chkIfCorrective.Value = 1 Then
                    Load FrmChange
                    FrmChange.Show vbModal
                    
                    Data1.Recordset.Fields(0).Value = lRecordCounter
                    Data1.Recordset.Fields(1).Value = sLicenceTemp
                    Data1.Recordset.Fields(2).Value = sIMEITemp
                    Data1.Recordset.Fields(3).Value = sSNTemp
                    
                    On Error GoTo Err2
                    Data1.UpdateRecord
                    Data1.Recordset.Bookmark = Data1.Recordset.LastModified
                End If
            End If
         
        End If
Err2:
    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(1).Value) Then
    txtLicence.Text = ""
    
  Else
    txtLicence.Text = Data1.Recordset.Fields(1).Value
  End If
  txtIMEI.Text = Data1.Recordset.Fields(2).Value
  If IsNull(Data1.Recordset.Fields(3).Value) Then
    txtSN.Text = ""
  Else
    txtSN.Text = Data1.Recordset.Fields(3).Value
  End If

Else
  txtItemNo.Text = ""
  txtLicence.Text = ""
  txtIMEI.Text = ""
  txtSN.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 Form_Load()
frmmain.txtItemNo.Text = ""
frmmain.txtLicence.Text = ""
frmmain.txtIMEI.Text = ""
frmmain.txtSN.Text = ""

frmmain.txtIMEISourceName.Text = ""
frmmain.txtIMEIDatabaseFileName.Text = ""

chkIfCorrective.Value = 1
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 sNetLabel As Variant, ByVal sIMEI As String, ByVal sSN As String) As Boolean
Dim iRecordNo As Integer
Dim sErrorMessage As String

On Error GoTo Err1

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

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

Data1.Recordset.Fields(0).Value = lItemNo
Data1.Recordset.Fields(1).Value = sNetLabel
Data1.Recordset.Fields(2).Value = sIMEI
Data1.Recordset.Fields(3).Value = sSN

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 & "Licence:  " & sNetLabel & vbCrLf
'    sErrorMessage = sErrorMessage & "IMEI:  " & sIMEI & vbCrLf
'    sErrorMessage = sErrorMessage & "SN:  " & sSN & vbCrLf
    
'    MsgBox sErrorMessage
    AddNewRecordset = False 'There are some error occured.
End Function

Private Function GetNextItemNo() As Long
Dim iRecordNo As Integer

On Error GoTo Err1

iRecordNo = Data1.Recordset.AbsolutePosition
If iRecordNo < 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