frmimport.frm

简单的access应用程序

            Width           =   855
         End
         Begin VB.OptionButton optDelimiter 
            Caption         =   "&Space"
            Height          =   195
            Index           =   3
            Left            =   3960
            TabIndex        =   7
            Top             =   350
            Width           =   855
         End
         Begin VB.OptionButton optDelimiter 
            Caption         =   "&Other"
            Height          =   195
            Index           =   4
            Left            =   5160
            TabIndex        =   8
            Top             =   350
            Width           =   735
         End
         Begin VB.TextBox txtOther 
            Height          =   285
            Left            =   6000
            TabIndex        =   9
            Top             =   320
            Width           =   330
         End
      End
      Begin VB.CheckBox chkFirstRow 
         Caption         =   "&First Row Contains Field Names"
         Height          =   255
         Left            =   120
         TabIndex        =   10
         Top             =   1870
         Width           =   2655
      End
      Begin VB.ComboBox cboQualifier 
         Height          =   315
         Left            =   5880
         TabIndex        =   11
         Text            =   "cboQualifier"
         Top             =   1860
         Width           =   855
      End
      Begin VB.Frame fraOptions 
         Caption         =   "Field Options"
         Height          =   735
         Left            =   120
         TabIndex        =   22
         Top             =   2760
         Width           =   6615
         Begin VB.ComboBox cboType 
            Height          =   315
            Left            =   4560
            TabIndex        =   13
            Top             =   280
            Width           =   1695
         End
         Begin VB.TextBox txtField 
            Height          =   285
            Left            =   1440
            TabIndex        =   12
            Top             =   280
            Width           =   1530
         End
         Begin VB.Label Label3 
            AutoSize        =   -1  'True
            Caption         =   "Field Name:"
            Height          =   195
            Index           =   0
            Left            =   480
            TabIndex        =   24
            Top             =   315
            Width           =   840
         End
         Begin VB.Label Label3 
            AutoSize        =   -1  'True
            Caption         =   "Data Type:"
            Height          =   195
            Index           =   1
            Left            =   3600
            TabIndex        =   23
            Top             =   315
            Width           =   795
         End
      End
      Begin MSFlexGridLib.MSFlexGrid flxPreview 
         Height          =   1845
         Left            =   120
         TabIndex        =   14
         Top             =   3600
         Width           =   6645
         _ExtentX        =   11721
         _ExtentY        =   3254
         _Version        =   393216
         ForeColorFixed  =   -2147483640
         BackColorSel    =   12582912
         BackColorBkg    =   -2147483644
         GridColor       =   -2147483640
         GridColorFixed  =   -2147483640
         BorderStyle     =   0
         Appearance      =   0
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "Text &Qualifier:"
         Height          =   195
         Left            =   4680
         TabIndex        =   27
         Top             =   1875
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   $"FrmImport.frx":5B1DB
         Height          =   375
         Index           =   1
         Left            =   120
         TabIndex        =   26
         Top             =   2280
         Width           =   6735
      End
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00FFFFFF&
      Index           =   1
      X1              =   0
      X2              =   7080
      Y1              =   5655
      Y2              =   5655
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00808080&
      Index           =   0
      X1              =   0
      X2              =   6960
      Y1              =   5640
      Y2              =   5640
   End
End
Attribute VB_Name = "FrmImport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'ASCII import wizard by Richard Gardner
'April 17th, 2000

Private aryNameAndType As Variant
Private aryFields As Variant
Private intIndex As Integer
Private intStep As Integer
Private ASCIIFileName As String
Private AccessFileName As String
Private AccessTableName As String
Private Edited As Boolean
Private strDelimiter As String
Private Complete As Boolean

Private Sub ImportASCII()
    Dim dbMain As Database
    Dim rsMain As Recordset
    Dim intFound As Integer
    Dim strLine As String
    Dim intLoop As Integer
    Dim strFields As String
    Dim lngFileLen As Long
    Dim lngProgress As Long
    'Validate
    picWizard(3).MousePointer = vbHourglass
    If Dir(AccessFileName) = "" Or AccessFileName = "" Or ASCIIFileName = "" Or Dir(ASCIIFileName) = "" Then
        Err.Raise 100, "Import", "Bad File Name"
    End If
    lngFileLen = FileLen(ASCIIFileName)
    lngProgress = lngFileLen / 100
    Set dbMain = OpenDatabase(AccessFileName)
    On Error Resume Next
    dbMain.Execute "DROP TABLE " & AccessTableName & ";"
    On Error GoTo ErrHndl
    'Compile field information
    strFields = ""
    For intLoop = 1 To UBound(aryNameAndType)
        strFields = strFields & aryNameAndType(intLoop, 1) & " " & aryNameAndType(intLoop, 2) & ", "
    Next intLoop
    strFields = Mid(strFields, 1, Len(strFields) - 2)
    strFields = Replace(strFields, "AUTONUMBER", "COUNTER")
    dbMain.Execute "CREATE TABLE " & AccessTableName & "(" & strFields & ");"
    'Now import the text file into the new database
    Set rsMain = dbMain.OpenRecordset(AccessTableName)
    Open ASCIIFileName For Input As #1
    'Remove first row if it contains field names
    If chkFirstRow.Value = 1 Then
        Line Input #1, strLine
    End If
    On Error Resume Next
    Do While Not EOF(1)
        Line Input #1, strLine
        'Remove text qualifiers
        If InStr(strLine, cboQualifier.Text) <> 0 Then strLine = Replace(strLine, cboQualifier.Text, "")
        lngBytes = lngBytes + Len(strLine)
        rsMain.AddNew
        For intLoop = 1 To Len(strLine)
            intFound = InStr(strLine, strDelimiter)
            If intFound = 0 Then
                rsMain.Fields(intLoop - 1).Value = Trim$(strLine)
                Exit For
            End If
            rsMain.Fields(intLoop - 1).Value = Trim$(Mid(strLine, 1, intFound - 1))
            strLine = Mid(strLine, intFound + 1)
        Next intLoop
        rsMain.Update
        DoEvents
        'update progress
        lblPercent = Abs(CInt((lngBytes / lngFileLen) * 100 - 1)) & "% Complete"
    Loop
    Close #1
    DoEvents
    dbMain.Close
    picWizard(3).MousePointer = vbNormal
    lblPercent = "100% Complete"
    tmrUnload.Enabled = True
    Exit Sub
ErrHndl:
    Close
    picWizard(3).MousePointer = vbNormal
    cmdNext.Enabled = True
    cmdPrevious.Enabled = True
    cmdFinish.Enabled = False
    picWizard(intStep).Visible = False
    intStep = 2
    picWizard(intStep).Visible = True
    MsgBox Err.Description, vbInformation, "Error:"
End Sub

Private Function PreviewASCII(Delimiter As String)
    Dim intFound As Integer
    Dim intLoop As Integer
    Dim intRows As Integer
    Dim intStart As Integer
    Dim strLine As String
    Dim strGrid As String

    ReDim aryFields(0)
    ReDim aryNameAndType(0, 1 To 2)

    strDelimiter = Delimiter

    flxPreview.Clear
    flxPreview.Cols = 0
    flxPreview.Rows = 1

    FileName = ASCIIFileName

    On Error GoTo ErrHndl

    'Validate again
    If Dir(FileName) = "" Or FileName = "" Then
        ASCIIFileName = ""
        txtFrom = ""
        picWizard(intStep).Visible = False
        intStep = 1
        picWizard(intStep).Visible = True
        MsgBox "Bad file name!", vbInformation, "Error:"
        Exit Function
    End If

    'Remove junk from tablename

    'First, see how many fields there are
    Open FileName For Input As #1
    Line Input #1, strLine
    Close #1

    For intLoop = 1 To Len(strLine)
        intFound = InStr(strLine, Delimiter)
        If intFound = 0 Then
            ReDim Preserve aryFields(1 To UBound(aryFields) + 1)
            aryFields(intLoop) = Trim$(strLine)
            Exit For
        End If
        ReDim Preserve aryFields(1 To UBound(aryFields) + 1)
        aryFields(intLoop) = Trim$(Mid(strLine, 1, intFound - 1))
        strLine = Mid(strLine, intFound + 1)
    Next intLoop

    ReDim aryNameAndType(1 To UBound(aryFields), 1 To 2)
    For intLoop = 1 To UBound(aryFields)
        If chkFirstRow.Value = 1 Then
            aryNameAndType(intLoop, 1) = aryFields(intLoop)
        Else
            aryNameAndType(intLoop, 1) = "Field" & intLoop
        End If
        aryNameAndType(intLoop, 2) = "TEXT"
    Next intLoop

    'Add the columns
    For intLoop = 1 To UBound(aryFields)
        flxPreview.Cols = flxPreview.Cols + 1
        flxPreview.Col = intLoop - 1
        flxPreview.Row = 0
        flxPreview.Text = aryFields(intLoop)
    Next intLoop

    'Fill the grid with about 7 rows of data
    Open FileName For Input As #1

    intRows = 1
    flxPreview.Rows = 2

    Do While Not EOF(1)
        Line Input #1, strLine
        'Insert this row into the grid
        For intLoop = 1 To UBound(aryFields)
            intFound = InStr(strLine, Delimiter)
            If intFound = 0 Then
                strGrid = Trim$(strLine)
            Else
                strGrid = Trim$(Mid(strLine, 1, intFound - 1))
                strLine = Trim$(Mid(strLine, intFound + 1))
            End If
            'Insert strGrid