思路：先打开选择文件的对话框，选择好文件后再导出数据至EXCEL

Private Sub 导出EXCEL_Click()

CommonDialog1.Filter = "Excel文件(*.xls)|*.xls"

CommonDialog1.ShowOpen

Dim Lujing As String

If CommonDialog1.FileName <> "" Then

Lujing = CommonDialog1.FileName ' 取得附件路径

Call OpenConn

Dim rs As New ADODB.Recordset

rs.CursorLocation = adUseClient

Dim sq1 As String

sq1 = "select * from 出口核注清单明细 "

rs.Open sq1, cn, adOpenKeyset, adLockOptimistic

Set DataGrid2.DataSource = rs

DataGrid2.Columns(0).Width = 800

DataGrid2.Columns(1).Width = 800

DataGrid2.Columns(2).Width = 1000

DataGrid2.Columns(3).Width = 800

DataGrid2.Columns(4).Width = 800

DataGrid2.Columns(5).Width = 1000

DataGrid2.Columns(6).Width = 1000

DataGrid2.Columns(7).Width = 1000

DataGrid2.Columns(8).Width = 1000

DataGrid2.Columns(9).Width = 1000

DataGrid2.Columns(10).Width = 1000

DataGrid2.Columns(11).Width = 1000

DataGrid2.Columns(12).Width = 1000

DataGrid2.Columns(13).Width = 1000

DataGrid2.Columns(14).Width = 1000

DataGrid2.Columns(15).Width = 1000

DataGrid2.Columns(16).Width = 1000

DataGrid2.Columns(17).Width = 1000

DataGrid2.Columns(18).Width = 1000

DataGrid2.Columns(19).Width = 500

DataGrid2.Columns(20).Width = 500

DataGrid2.Columns(21).Width = 500

DataGrid2.Columns(22).Width = 500

DataGrid2.Columns(23).Width = 800

DataGrid2.Columns(24).Width = 800

DataGrid2.Columns(25).Width = 800

DataGrid2.Columns(26).Width = 1000

If rs.RecordCount <= 0 Then

MsgBox "没有可输出的数据！", vbExclamation, "提示信息"

Exit Sub

End If

Dim I, J, k As Integer

Dim xlapp As Object

Dim xlBook As Object

Dim xlsheet As Object

Set xlapp = CreateObject("excel.application")

xlapp.Visible = True

Set xlBook = xlapp.workbooks.Open(Lujing)

Set xlsheet = xlBook.worksheets("表体")

xlBook.Sheets("表体").Select

'For K = 1 To DataGrid2.Columns.Count

'xlsheet.Cells(2, K) = DataGrid2.Columns(K - 1).Caption

'Next K

rs.MoveFirst

For I = 1 To rs.RecordCount

For J = 0 To DataGrid2.Columns.Count - 1

DataGrid2.Col = J

xlsheet.Cells(I + 1, J + 1) = "'" & DataGrid2.Text

Next J

rs.MoveNext

Next I

Set xlapp = Nothing

Set xlBook = Nothing

Set xlsheet = Nothing

CommonDialog1.FileName = ""

Else

MsgBox "没有选择文件"

End If

End Sub