我用的就是在这里看的代码


Public Function ExporToExcel(str1 as string,str2 as string)

'ExporToExcel = False
'On Error GoTo ErrHandler

    Dim Rs_Data As New ADODB.Recordset
    Dim Irowcount As Integer
    Dim Icolcount As Integer
    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlQuery As Excel.QueryTable
    
'    Dim Conn As New Connection
'    Set Conn = New ADODB.Connection
'    Conn.Open str1
    

    With Rs_Data
        If .State = adStateOpen Then
            .Close
        End If
        .ActiveConnection = str1
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Source = str2
        .Open
    End With
    
    With Rs_Data
        If .RecordCount < 1 Then
            MsgBox ("沒有數據記錄!")
            Exit Function
        End If
        Irowcount = .RecordCount          '記錄總數
        Icolcount = .Fields.Count         '字段總數
    End With
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlBook = xlApp.Workbooks().Add
    Set xlSheet = xlBook.Worksheets("sheet1")
    xlApp.Visible = True
    
    Set xlQuery = xlSheet.QueryTables.Add(Rs_Data, xlSheet.Range("a1"))

    With xlQuery
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
    End With

    xlQuery.FieldNames = True
    xlQuery.Refresh
    
    With xlSheet
        .Range(.Cells(1, 1), .Cells(1, Icolcount)).Font.Bold = True    '字体加粗
        .Range(.Cells(1, 1), .Cells(Irowcount + 1, Icolcount)).Borders.LineStyle = xlContinuous    '表格邊框樣式
    End With
    
    xlApp.Application.Visible = True
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
    ExporToExcel = True

'ErrHandler:
'    MsgBox "(" & Err.Number & ")" & Err.Description
'
End Function

你试试把数据库连接的字符串拆开传，vb中的关键字别传，然后在vb中将字符串做连接。