form1.frm

这个是用VB做的一个小程序Text文件转换成MDB文件!

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Text(*.txt)文件转换成Access(*.mdb)"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton data_disposal 
      Caption         =   "数据处理"
      Height          =   495
      Left            =   1680
      TabIndex        =   3
      Top             =   240
      Width           =   1215
   End
   Begin VB.CommandButton Data_Convert 
      Caption         =   "数据转换"
      Height          =   495
      Left            =   3240
      TabIndex        =   2
      Top             =   240
      Width           =   1215
   End
   Begin VB.FileListBox File1 
      Height          =   2070
      Left            =   0
      Pattern         =   "*.csv;*.txt"
      TabIndex        =   1
      Top             =   960
      Width           =   1455
   End
   Begin VB.CommandButton select_folder 
      Caption         =   "选择文件夹"
      Height          =   495
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public SelectDir As String

Public Function loaddata(Path$, txt_name$, mdb_name$) As Boolean
    
    Dim cat As New ADOX.Catalog
    Dim tbl As New Table
    Dim pstr As String
    Dim db As String
    Dim row_no As Integer
    Dim col_no As Integer
    
    Set cdata = New ADODB.Connection
    Set rdata = New ADODB.Recordset
    
    db = Path & "\" & mdb_name & ".mdb"
    pstr = "Provider=Microsoft.Jet.OLEDB.4.0;"         '数据库驱动 4.0 For Office 2k/2003, 3.5.1 For Office 97
    pstr = pstr & "Data Source=" & db
    cat.Create pstr
    cat.ActiveConnection = pstr
    
    conn_str = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Path & "\" & mdb_name & ".mdb"
    tbl_name = Replace(CStr(Mid(txt_name, 1, Len(txt_name) - 4)), " ", "")
    tbl_name = Replace(tbl_name, "　", "")
    tbl.Name = tbl_name
   
    Open SelectDir & "\" & Mid(txt_name, 1, Len(txt_name) - 4) & "_tmp.txt" For Input As #1
    row_no = 0
    
    Input #1, stemp
    data_tmp = Split(stemp, ";")
    
    For col_no = 0 To UBound(data_tmp)
        tbl.Columns.Append data_tmp(col_no), adVarWChar
    Next
    
    cat.Tables.Append tbl
    
    Set tbl = Nothing
    Set cat = Nothing
    
    cdata.Open pstr
    rdata.Open "Select * From " & tbl_name, cdata, adOpenStatic, adLockOptimistic

    Do While Not EOF(1)
        row_no = row_no + 1
        Line Input #1, stemp
        If row_no > 0 Then
            data_tmp = Split(stemp, ";")
            rdata.AddNew
            For col_no = 0 To UBound(data_tmp)
                rdata.Fields(rdata.Fields(col_no).Name) = data_tmp(col_no)
            Next
        
            rdata.Update
        End If
    Loop
    
    Close #1
    
    cdata.Close: Set cdata = Nothing
    Set rdata = Nothing

    loaddata = True

End Function


Private Sub data_disposal_Click()

    Dim tmp_files As String
    Dim file_connt As Integer
    file_connt = 0
    
    If File1.ListCount > 0 Then
        For i = 0 To File1.ListCount - 1
        
            tmp_files = SelectDir & "\" & Mid(File1.List(i), 1, Len(File1.List(i)) - 4) & "_tmp.txt"
            Set fs = CreateObject("Scripting.FileSystemObject")
            Set a = fs.CreateTextFile(tmp_files, False)
            a.Close
            Set fs = Nothing
            
            Open SelectDir & "\" & File1.List(i) For Input As #1
            Open tmp_files For Output As #2
            
            Do While Not EOF(1)
                Line Input #1, Tmp_str
                tmpdata = Split(Tmp_str, ";")
                For x = 0 To UBound(tmpdata)
                    If InStr(tmpdata(x), "?") > 0 Then
                        tmpdata(x) = Mid(tmpdata(x), 1, InStr(tmpdata(x), "?") - 1)
                        tmpdata(x) = Replace(tmpdata(x), " ", "")
                        tmpdata(x) = Replace(tmpdata(x), "　", "")
                    Else
                        tmpdata(x) = Replace(tmpdata(x), " ", "")
                        tmpdata(x) = Replace(tmpdata(x), "　", "")
                    End If
                Next
                tmpdata = Join(tmpdata, ";")
                Print #2, tmpdata
            Loop
            
            Close #1
            Close #2
            
            isok = loaddata(SelectDir, File1.List(i), Mid(File1.List(i), 1, Len(File1.List(i)) - 4))
            If isok Then file_connt = file_connt + 1
        Next
    End If
    
    MsgBox "转换 " & file_connt & " 个数据完成！"
End Sub

Private Sub data_Convert_Click()
    If File1.ListCount > 0 Then
        For i = 0 To File1.ListCount - 1
        Next
    End If
End Sub


Private Sub select_folder_Click()
    On Error Resume Next
    Set sShell = CreateObject("Shell.Application")
    'object.BrowseForFolder hWnd, Title, Options, [RootFolder]
    '参数：hWnd为显示窗口句柄; Title为窗口显示的内容; Options为显示打开窗口的类型; RootFolder为初始路径
    Set sDlg = sShell.BrowseForFolder(0, "请先择数据所在的文件夹！", &H10, "")
    Set sDir = sDlg.Self
    SelectDir = sDir.Path
    If Not SelectDir = "" Then File1.Path = SelectDir: File1.Refresh
    sShell.Close: sShell = Nothing
    sDlg.Close: sDlg = Nothing
    sDir.Close: sDir = Nothing
    
End Sub

Private Sub Form_Load()
    SelectDir = ""
End Sub