|
- '右键导出EXCEL button
- Public Function ExcelOut()
- Dim obj As Control
- Dim frm As Form
- Dim frm_p As Form
- Dim strFileName As String
- Dim s1 As String
- Dim s2 As String
- Dim strSQL As String
- Dim strSQL2 As String
- '取得要导出的数据所在的窗体和子窗体
- Set obj = Screen.ActiveControl
- Set frm = obj.Parent
- Set frm_p = frm.Parent
-
- strSQL = Forms(frm_p.Name).Controls(frm.Name).Form.RecordSource
- 'strSQL = Forms!frm策略组合维护.frm策略组合维护_子窗体.Form.RecordSource
- 'Debug.Print strSQL
-
- '取得另存为文件名
- With Application.FileDialog(msoFileDialogSaveAs)
- .InitialFileName = strPathOut & frm_p.Caption & ".xls"
- If Not .Show Then Exit Function
- strFileName = .SelectedItems(1)
- If Not strFileName Like "*" & ".xls" Then
- strFileName = strFileName & ".xls"
- End If
- If Len(Dir(strFileName)) > 0 Then Kill strFileName
- End With
-
- '将recordsource断句为select和from
- s1 = Mid(strSQL, 1, InStrRev(strSQL, "from") - 1)
- s2 = Mid(strSQL, InStrRev(strSQL, "from"))
-
- strSQL2 = s1 & "INTO [Sheet1] IN '" & strFileName & "' 'EXCEL 8.0;'" & s2 & ";"
- 'Debug.Print strSQL2
- DoCmd.RunSQL strSQL2
-
-
- End Function
复制代码 |
|