frmimport.frm

简单的access应用程序

            flxPreview.Col = intLoop - 1
            flxPreview.Row = intRows
            flxPreview.Text = strGrid
        Next intLoop
        intLoop = intLoop + 1
        If intRows = 7 Then Exit Do
        intRows = intRows + 1
        flxPreview.Rows = flxPreview.Rows + 1
    Loop
    Close #1

    'Display the column captions
    flxPreview.Row = 0
    For intLoop = 1 To UBound(aryFields)
        flxPreview.Col = intLoop - 1
        flxPreview.Text = aryFields(intLoop)
    Next intLoop

    flxPreview.Rows = flxPreview.Rows - 1

    If chkFirstRow.Value = False Then
        flxPreview.Row = 0
        For intLoop = 1 To UBound(aryFields)
            flxPreview.Col = intLoop - 1
            flxPreview.Text = aryNameAndType(intLoop, 1)
        Next intLoop
    Else
        flxPreview.RemoveItem 1
    End If

    cmdFinish.Enabled = True

    Exit Function

ErrHndl:
    MsgBox Err.Description, vbInformation, "Error:"

End Function

Private Sub cboType_Click()
    SaveType
End Sub

Private Sub cboType_Change()
    SaveType
End Sub

Private Sub SaveType()
    If flxPreview.Col = -1 Then Exit Sub
    aryNameAndType(flxPreview.Col + 1, 2) = cboType.Text
End Sub

Private Sub chkFirstRow_Click()
    optDelimiter_Click (intIndex)
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdFinish_Click()
    Dim intLoop As Integer
    Dim strTrashCan As String
    Dim strTrash As String
    'check for junk and duplicate names
    Randomize
    cmdFinish.Enabled = False
    cmdPrevious.Enabled = False
    For intLoop = 1 To UBound(aryNameAndType, 1)
        If InStr(strTrashCan, aryNameAndType(intLoop, 1)) <> 0 Then
            If chkFix.Value = 1 Then
                aryNameAndType(intLoop, 1) = aryNameAndType(intLoop, 1) & Rnd * 100
            Else
                MsgBox "Duplicate field name '" & aryNameAndType(intLoop, 1) & "'", vbInformation, "Text Import Wizard"
                picWizard(intStep).Visible = False
                picWizard(2).Visible = True
                intStep = 2
                cmdNext.Enabled = True
                cmdFinish.Enabled = True
                Exit Sub
            End If
        Else
            strTrashCan = strTrashCan & "|" & aryNameAndType(intLoop, 1)
            strTrash = RemoveJunk(CStr(aryNameAndType(intLoop, 1)))
            If Len(strTrash) <> Len(aryNameAndType(intLoop, 1)) Or Len(strTrash) = 0 Then
                If chkFix.Value = 1 Then
                    aryNameAndType(intLoop, 1) = RemoveJunk(CStr(aryNameAndType(intLoop, 1)))
                    If Len(aryNameAndType(intLoop, 1)) = 0 Then aryNameAndType(intLoop, 1) = "Field" & intLoop
                Else
                    MsgBox "Invalid field name '" & aryNameAndType(intLoop, 1) & "'", vbInformation, "Text Import Wizard"
                    picWizard(intStep).Visible = False
                    picWizard(2).Visible = True
                    intStep = 2
                    cmdNext.Enabled = True
                    cmdFinish.Enabled = True
                    Exit Sub
                End If
            End If
        End If
    Next intLoop
    strTrash = txtName
    If Len(RemoveJunk(txtName)) <> Len(strTrash) Or Len(strTrash) = 0 Then
        If chkFix.Value = 1 Then
            txtName = RemoveJunk(CStr(txtName))
            If Len(txtName) = 0 Then txtName = "Table1"
        Else
            MsgBox "Invalid Table Name '" & txtName & "'", vbInformation, "Text Import Wizard"
            picWizard(intStep).Visible = False
            picWizard(3).Visible = True
            intStep = 3
            cmdNext.Enabled = True
            cmdFinish.Enabled = True
            Exit Sub
        End If
    End If
    ImportASCII
End Sub

Private Sub cmdFrom_Click()
    Dim intFound As Integer
    CD1.DialogTitle = "All Files"
    CD1.Filter = "All Files|*.*"
    CD1.ShowOpen
    ASCIIFileName = CD1.FileName
    If Len(CD1.FileName) > 25 Then
        intFound = InStr(20, CD1.FileName, "\")
        If intFound <> 0 Then
            CD1.FileName = Mid(ASCIIFileName, 1, intFound) & "...\" & CD1.FileTitle
        End If
    End If
    txtFrom = CD1.FileName
    CD1.FileName = ""
End Sub

Private Sub cmdTo_Click()
    Dim intFound As Integer
    CD1.DialogTitle = "Microsoft Access Files"
    CD1.Filter = "Microsoft Access Files|*.mdb"
    CD1.ShowOpen
    AccessFileName = CD1.FileName
    If Len(CD1.FileName) > 25 Then
        intFound = InStr(20, CD1.FileName, "\")
        If intFound <> 0 Then
            CD1.FileName = Mid(AccessFileName, 1, intFound) & "...\" & CD1.FileTitle
        End If
    End If
    txtTo = CD1.FileName
    If cmdNext.Enabled Then cmdNext.SetFocus
    CD1.FileName = ""
End Sub

Private Sub cmdNext_Click()
    If intStep = 0 Then cmdNext.Enabled = False: CheckFileNames
    cmdPrevious.Enabled = True
    picWizard(intStep).Visible = False
    intStep = intStep + 1
    If intStep + 1 = picWizard.Count Then cmdNext.Enabled = False
    If intStep = picWizard.Count Then intStep = intStep - 1
    picWizard(intStep).Visible = True
    picHeader.Visible = True
    DisplayCaption
    If intStep = 3 Then cmdFinish.Enabled = True
End Sub

Private Sub cmdPrevious_Click()
    picWizard(intStep).Visible = False
    cmdNext.Enabled = True
    cmdFinish.Enabled = False
    If intStep <= 1 Then picHeader.Visible = False: cmdPrevious.Enabled = False
    If intStep = 0 Then intStep = intStep + 1
    intStep = intStep - 1
    picWizard(intStep).Visible = True
    DisplayCaption
End Sub

Private Sub DisplayCaption()
    Select Case intStep
        Case 1
            lblHeader = "Choose a Data Source and Destination"
            lblStep = "Locate the ASCII Text file you wish to import data from and then locate the " & _
                    "Microsoft Acccess Database file to import data into."
            txtFrom.SetFocus
        Case 2
            lblHeader = "Specify Field Information"
            lblStep = "What delimiter seperates your fields?  Select the appropriate delimiter and " & _
                    "see how your text is affected in the preview below."
            'Since this is the screen where the preview is displayed, we need to refresh the preview grid
            If Not Edited Then Call optDelimiter_Click(intIndex)
            flxPreview.SetFocus
        Case 3
            lblHeader = "Finished!"
            lblStep = "Choose a Table Name for the Imported Text"
            txtName.SetFocus
            txtName.SelStart = 0
            txtName.SelLength = Len(txtName)
    End Select
End Sub

Private Sub flxPreview_Click()
    If flxPreview.Rows = 0 Then Exit Sub
    flxPreview.Row = 0
    flxPreview.RowSel = flxPreview.Rows - 1
    If flxPreview.Col = -1 Then Exit Sub
    txtField = aryNameAndType(flxPreview.Col + 1, 1)
    cboType.Text = aryNameAndType(flxPreview.Col + 1, 2)
    txtField.SetFocus
    txtField.SelStart = 0
    txtField.SelLength = Len(txtField)
End Sub

Private Sub Form_Load()
    flxPreview.Cols = 0
    cboQualifier.AddItem Chr$(34)
    cboQualifier.AddItem "'"
    cboQualifier.AddItem "{none}"
    cboQualifier.Text = "{none}"
    cboType.AddItem "DOUBLE"
    cboType.AddItem "NUMBER"
    cboType.AddItem "TEXT"
    cboType.AddItem "MEMO"
    cboType.AddItem "DATE/TIME"
    cboType.AddItem "CURRENCY"
    cboType.AddItem "AUTONUMBER"
    cboType.AddItem "YES/NO"
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If Not Complete Then
        Dim Answer As VbMsgBoxResult
        Answer = MsgBox("Cancel the Text Import Wizard?", vbQuestion + vbYesNo + vbDefaultButton2, "Text Import Wizard")
        If Answer = vbNo Then Cancel = True: Exit Sub
    End If
    Unload Me
    End 'Just incase it's stuck in the importing function
End Sub

Private Sub optDelimiter_Click(Index As Integer)
    intIndex = Index
    Select Case Index
        Case 0
            PreviewASCII vbTab
        Case 1
            PreviewASCII ";"
        Case 2
            PreviewASCII ","
        Case 3
            PreviewASCII " "
        Case 4
            txtOther.SetFocus
    End Select
End Sub

Private Sub tmrUnload_Timer()
    Complete = True
    Unload Me
End Sub

Private Sub txtField_Change()
    If flxPreview.Col = -1 Then Exit Sub
    aryNameAndType(flxPreview.Col + 1, 1) = txtField
    flxPreview.Row = 0
    flxPreview.Text = txtField
    flxPreview.RowSel = flxPreview.Rows - 1
End Sub

Private Sub txtField_LostFocus()
    Edited = True
End Sub

Private Sub txtName_Change()
    AccessTableName = txtName
End Sub

Private Sub txtTo_Change()
    CheckFileNames
End Sub

Private Sub txtFrom_Change()
    CheckFileNames
End Sub

Private Sub txtTo_LostFocus()
    If InStr(txtTo, "...") = 0 Then ASCIIFileName = txtTo
End Sub

Private Sub txtFrom_LostFocus()
    If InStr(txtFrom, "...") = 0 Then ASCIIFileName = txtFrom
End Sub

Private Sub txtOther_Change()
    PreviewASCII txtOther
End Sub

Private Sub CheckFileNames()
    If InStr(ASCIIFileName, "...") <> 0 Then txtFrom = "": ASCIIFileName = ""
    If InStr(AccessFileName, "...") <> 0 Then txtTo = "": AccessFileName = ""
    If Dir(ASCIIFileName) <> "" And txtFrom <> "" And Dir(AccessFileName) <> "" And txtTo <> "" Then
        cmdNext.Enabled = True
    Else
        cmdNext.Enabled = False
        cmdFinish.Enabled = False
    End If
End Sub

Private Function RemoveJunk(strData As String)
    Dim lngLoop As Long
    Dim strTmp As String
    Dim strChar As String
    For lngLoop = 1 To Len(strData)
        strChar = Mid(strData, lngLoop, 1)
        If strChar Like "[A-Z]" Or strChar Like "[a-z]" Or strChar Like "[0-9]" Then
            strTmp = strTmp & Mid(strData, lngLoop, 1)
        End If
        DoEvents
    Next lngLoop
    If Mid(strTmp, 1, 1) Like "#" Then strTmp = ""
    RemoveJunk = strTmp
End Function