定时每天的十点把Excel文件导入到数据库，求解答啊，有代码更好·····

本人初学，希望详细点。

以下代码是一个大神写的 
Option Explicit
Private AccessFile As String
Private ExcelFile As String
Private ExcelApp As Excel.Application
Private Sub Command2_Click()
    Dim Conn As ADODB.Connection
    Dim XlsSheet As Excel.Worksheet
    Dim i As Long, j As Long, k As Long
    Dim l As Integer
    Dim Sql As String, InsertSql As String, ValStr As String
    Dim MaxWidth As Long, FieldLine As Long
    Dim Rs As ADODB.Recordset, RsData As ADODB.Recordset
    'first: get two filenames

    CommonDialog1.Filter = "Access File(*.mdb)|*.mdb"
    CommonDialog1.DialogTitle = "Open Access File"
    CommonDialog1.FileName = ""
    CommonDialog1.ShowOpen
    If CommonDialog1.FileName = "" Then Exit Sub
    AccessFile = CommonDialog1.FileName

CommonDialog1.Filter = "Excel File(*.xls)|*.xls"
    CommonDialog1.DialogTitle = "Export to Excel File"
    CommonDialog1.FileName = ""
    CommonDialog1.ShowSave
    If CommonDialog1.FileName = "" Then Exit Sub
    ExcelFile = CommonDialog1.FileName

    On Error GoTo ErrOpenXls
    If Dir(ExcelFile) = "" Then
        ExcelApp.Workbooks.Add
        ExcelApp.ActiveWorkbook.SaveAs ExcelFile
    Else
        ExcelApp.Workbooks.Open ExcelFile
    End If
    On Error GoTo 0

    On Error GoTo ErrOpenMdb
    Set Conn = CreateObject("ADODB.Connection")
    Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & AccessFile
    On Error GoTo 0

    Set Rs = Conn.OpenSchema(adSchemaTables) 'get table name list
    Set RsData = CreateObject("ADODB.Recordset")
    While Not Rs.EOF
        If Rs("TABLE_TYPE").Value = "TABLE" Then
            If Left(Rs("TABLE_NAME").Value, 1) <> "~" Then
                l = 0
                For i = 1 To ExcelApp.ActiveWorkbook.Worksheets.Count
                    Set XlsSheet = ExcelApp.ActiveWorkbook.Sheets(i)
                    If Rs("TABLE_NAME").Value = XlsSheet.Name Then
                        l = MsgBox("Same table name exist, overwrite it?", vbQuestion + vbYesNo + vbDefaultButton2, "Overrite")
                        If l = vbYes Then
                            XlsSheet.Range("1:65536").Delete
                        End If
                        Exit For
                    End If
                Next i
                If l = 0 Then
                    Set XlsSheet = ExcelApp.ActiveWorkbook.Worksheets.Add
                    XlsSheet.Name = Rs("TABLE_NAME")
                End If
                If l = vbYes Or l = 0 Then
                    RsData.Open "Select * from " & Rs("TABLE_NAME").Value, Conn, adOpenKeyset, adLockOptimistic
                    For i = 1 To Rs.Fields.Count
                        XlsSheet.Cells(1, i) = RsData.Fields(i - 1).Name
                    Next i
                    i = 2
                    While Not RsData.EOF
                        For j = 1 To Rs.Fields.Count
                            XlsSheet.Cells(i, j) = RsData(j - 1).Value
                        Next j
                        i = i + 1
                        RsData.MoveNext
                    Wend
                    RsData.Close
                End If
            End If
        End If
        Rs.MoveNext
    Wend

    Rs.Close
    Conn.Close
    ExcelApp.ActiveWorkbook.Save
    ExcelApp.ActiveWorkbook.Close
    Set RsData = Nothing
    Set Rs = Nothing
    Set Conn = Nothing
    Exit Sub
ErrOpenXls:
    MsgBox "Open Excel File Failed", vbCritical, "Error"
    Exit Sub

ErrOpenMdb:
    MsgBox "Access File Connect Failed", vbCritical, "Error"
    ExcelApp.ActiveWindow.Close
    Exit Sub
End Sub

Private Sub Command1_Click()
    Dim Conn As ADODB.Connection
    Dim XlsSheet As Excel.Worksheet
    Dim i As Long, j As Long, k As Long
    Dim l As Integer
    Dim Sql As String, InsertSql As String, ValStr As String
    Dim MaxWidth As Long, FieldLine As Long
    Dim Rs As ADODB.Recordset
    'first: get two filenames

    CommonDialog1.Filter = "Excel File(*.xls)|*.xls"
    CommonDialog1.DialogTitle = "Open Excel File"
    CommonDialog1.FileName = ""
    CommonDialog1.ShowOpen
    If CommonDialog1.FileName = "" Then Exit Sub
    ExcelFile = CommonDialog1.FileName

CommonDialog1.Filter = "Access File(*.mdb)|*.mdb"
    CommonDialog1.DialogTitle = "Export to Access File"
    CommonDialog1.FileName = ""
    CommonDialog1.ShowOpen
    If CommonDialog1.FileName = "" Then Exit Sub
    AccessFile = CommonDialog1.FileName

    On Error GoTo ErrOpenXls
    ExcelApp.Workbooks.Open ExcelFile
    On Error GoTo 0

    On Error GoTo ErrOpenMdb
    Set Conn = CreateObject("ADODB.Connection")
    Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & AccessFile
    On Error GoTo 0

    Set Rs = Conn.OpenSchema(adSchemaTables) 'get table name list

    For i = 1 To ExcelApp.ActiveWorkbook.Worksheets.Count
        Set XlsSheet = ExcelApp.ActiveWorkbook.Sheets(i)

        Rs.MoveFirst
        l = vbYes
        Do While Not Rs.EOF
            If Rs("TABLE_TYPE").Value = "TABLE" Then 'check if exist
                If Rs("TABLE_NAME").Value = XlsSheet.Name Then
                    l = MsgBox("Same table name exist, overwrite it?", vbQuestion + vbYesNo + vbDefaultButton2, "Overrite")
                    If l = vbYes Then
                        Conn.Execute "drop table " & XlsSheet.Name
                    End If
                    Exit Do
                End If
            End If
            Rs.MoveNext
        Loop

        If l = vbYes Then
            Sql = "create table " & XlsSheet.Name & " ("
            MaxWidth = 0
            For j = 1 To XlsSheet.Range("A65536").End(xlUp).Row
                For k = 1 To XlsSheet.Range("IV" & j).End(xlToLeft).Column
                    If XlsSheet.Cells(j, k).MergeCells = True Or XlsSheet.Cells(j, k) = "" Then
                        Exit For 'contain a merged cell, skip this line
                    End If
                Next k
                If k > XlsSheet.Range("IV" & j).End(xlToLeft).Column Then
                    'get the max width of this sheet
                    MaxWidth = XlsSheet.Range("IV" & j).End(xlToLeft).Column
                    'there is no merged cell in this line, use it as field name line
                    Exit For
                End If
            Next j

            If MaxWidth > 0 Then
                FieldLine = j
                InsertSql = ""
                For j = 1 To MaxWidth
                    If IsNumeric(XlsSheet.Cells(FieldLine + 1, j)) Then
                        Sql = Sql & XlsSheet.Cells(FieldLine, j) & " int,"
                    Else
                        Sql = Sql & XlsSheet.Cells(FieldLine, j) & " varchar(255),"
                    End If
                    InsertSql = InsertSql & XlsSheet.Cells(FieldLine, j) & ","
                Next j
                Sql = Left(Sql, Len(Sql) - 1) 'remove last char
                InsertSql = Left(InsertSql, Len(InsertSql) - 1)
                Sql = Sql & ")"

                Conn.Execute Sql 'create table

                For j = FieldLine + 1 To XlsSheet.Range("A65536").End(xlUp).Row
                    ValStr = ""
                    For k = 1 To MaxWidth
                        If IsNumeric(XlsSheet.Cells(FieldLine + 1, k)) Then
                            ValStr = ValStr & Val(XlsSheet.Cells(j, k)) & ","
                        Else
                            ValStr = ValStr & "'" & XlsSheet.Cells(j, k) & "',"
                        End If
                    Next k
                    ValStr = Left(ValStr, Len(ValStr) - 1)
                    Conn.Execute "insert into " & XlsSheet.Name & " (" & InsertSql & ") values (" & ValStr & ")"
                Next j
            Else
                MsgBox "Failed to get field name, skip this sheet", vbCritical, "Error"
            End If
        End If
    Next i

    Rs.Close
    Conn.Close
    ExcelApp.ActiveWorkbook.Close
    Set Rs = Nothing
    Set Conn = Nothing
    Exit Sub
ErrOpenXls:
    MsgBox "Open Excel File Failed", vbCritical, "Error"
    Exit Sub

ErrOpenMdb:
    MsgBox "Access File Connect Failed", vbCritical, "Error"
    ExcelApp.ActiveWindow.Close
    Exit Sub
End Sub

Private Sub Form_Load()
    Set ExcelApp = CreateObject("Excel.Application")
    ExcelApp.Visible = False
    Command1.Caption = "Excel To Access"
    Command2.Caption = "Access to Excel"
    Label1.Caption = "Excel to Access note: Access file must be exist firstly."
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ExcelApp.Quit 'here quit it
End Sub
一个导入按钮 一个导出按钮

把图片存在一个文件夹里 数据库只存放图片相应的路径就行 把蒙文做成图片存的么？ 是扫描的档案么 那是不是可以把图片文件名命名为档案编号什么的