使用 hta 将数据从 access 数据库复制到 excel

Question

使用 hta，我试图从访问数据库中提取数据并想粘贴到新的 excel 文件中。下面是我尝试过的代码，但我不知道如何打开新的 excel 文件以及如何将查询数据粘贴到该 excel 文件。

下面是我试过的代码。

Dim conn 'GLOBAL doing this here so that all functions can use it
sub dotheconnection
    Set conn = CreateObject("ADODB.Connection")
    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source= C:\Users\Database\data.mdb;User Id=; Password="
    If conn.errors.count <> 0 Then 
        alert("problem connecting to the database")
    end if
end Sub


sub Search
   SQL_query = "SELECT * FROM dvd WHERE agent = 'Sharath Chandra Das' "
    Set rsData = conn.Execute(SQL_query)
    'Here i want a code which should open new excel file and output should paste in this excel file
end Sub

Answer 1

有多种方法可以将记录集移动到 Excel，或将数据从 Access 复制到 Excel。

如果你想保持最小化：

Dim excelApp
Set excelApp = CreateObject("Excel.Application")
ExcelApp.Workbooks.Add 'New workbook
ExcelApp.Cells(1,1).CopyFromRecordset rsData
ExcelApp.Visible = True

就我个人而言，我使用以下代码：

Public Sub RecordsetToExcel(rs)
    Dim excelApp
    rs.MoveFirst
    Set excelApp = GetOrCreateObject("Excel.Application")
    excelApp.Visible = True
    excelApp.Workbooks.Add
    excelApp.ActiveSheet.Range("A2").CopyFromRecordset rs
    excelApp.WindowState = -4137 'xlMaximized
    Dim i
    For i = 0 To rs.Fields.Count - 1
        excelApp.ActiveSheet.Cells(1, i + 1).Value = rs.Fields(i).Name
        excelApp.ActiveSheet.Cells(1, i + 1).Columns.AutoFit
    Next
    With excelApp.ActiveSheet.ListObjects.Add(1, excelApp.ActiveSheet.Cells(1, 1).CurrentRegion, , , 1) 'xlSrcRange, xlYes
        .Name = TableName
        .TableStyle = "TableStyleLight1"
    End With
End Sub

其中 GetOrCreateObject 是以下函数：

Public Function GetOrCreateObject(Class)
    On Error Resume Next
    Set GetOrCreateObject = GetObject("", Class)
    If err.Number <> 0 Then
         Set GetOrCreateObject = CreateObject(Class)
    End If
End Function

使用 hta 将数据从 access 数据库复制到 excel

Using hta copy data from access database to excel

sql

vbscript

ms-access

hta