读者您好：

您的问题描述的不是很清楚，请参考如下代码：

Private Sub cmdExport_Click()
  Dim i As Integer, r As Integer, c As Integer
  Dim newxls As Excel.Application
  Dim newbook As Excel.Workbook
  Dim newsheet As Excel.Worksheet
  Set newxls = CreateObject("Excel.Application") '创建excel应用程序,打开excel2000
  Set newbook = newxls.Workbooks.Add   '创建工作簿
  Set newsheet = newbook.Worksheets(1) '创建工作表
  If sql <> "" Then
    Adodc1.RecordSource = sql
    Adodc1.Refresh
  End If
  If Adodc1.Recordset.RecordCount > 0 Then
    For i = 0 To DataGrid1.Columns.Count - 1
         newsheet.Cells(1, i + 1) = DataGrid1.Columns(i).Caption
    Next i
    '指定表格内容
    Adodc1.Recordset.MoveFirst
    Do Until Adodc1.Recordset.EOF
         r = Adodc1.Recordset.AbsolutePosition
         For c = 0 To DataGrid1.Columns.Count - 1
             DataGrid1.Col = c
             newsheet.Cells(r + 1, c + 1) = DataGrid1.Columns(c)
         Next c
         Adodc1.Recordset.MoveNext
    Loop
    Dim myval As Long
    Dim mystr As String
    myval = MsgBox("是否保存该Excel表?", vbYesNo, "提示窗口")
    If myval = vbYes Then
      mystr = InputBox("请输入文件名称", "输入窗口")
      If Len(mystr) = 0 Then
         MsgBox "系统不允许文件名称为空！", , "提示窗口"
         Exit Sub
      End If
      On Error GoTo ErrSave
      newsheet.SaveAs App.Path & "\Excel文件\" & mystr & ".xls"
      MsgBox "Excel文件保存成功，位置：" & App.Path & "\Excel文件\" & mystr & ".xls", , "提示窗口"
      newxls.Quit
ErrSave:
      Exit Sub
      MsgBox Err.Description, , "提示窗口"
    End If
  End If
End Sub