使用对话框保存生成的 excel 文件

Posted 2023-05-07

【中文标题】使用对话框保存生成的 excel 文件

【英文标题】：Save generated excel file with dialog

【发布时间】：2016-06-01 16:55:58

【问题描述】：

我在单击按钮时从数据表生成 xls 文件。现在保存文件的路径被硬编码在生成文件的函数中：

Function CreateExcelFile(xlFile As String) As Boolean

    Try
        Dim xlRow As Integer = 2
        Dim xlApp As New Microsoft.Office.Interop.Excel.Application
        Dim xlWB = xlApp.Workbooks.Add
        Dim xlWS = xlApp.Worksheets.Add
        Dim intStr As Integer = 0
        Dim NewFile As String = ""
        Dim strCaption As String = "PSLF Driver Files Records"

        xlFile = Replace(xlFile, "Return Files", "Reports")
        xlFile = Replace(xlFile, "txt", "xlsx")

        xlFile = Replace(xlFile, "_", " ")
        intStr = InStr(xlFile, "Reports")

        xlApp.IgnoreRemoteRequests = True

        xlWS = xlWB.Worksheets(xlApp.ActiveSheet.Name)
        xlApp.DisplayAlerts = False

        xlApp.Sheets.Add()

        Dim xlTopRow As Integer = 2 'First Row to enter data

        xlApp.Sheets.Add()

        xlApp.Sheets(1).Name = strCaption
        xlApp.Sheets(1).Select()

        'Store datatable in 2-dimensional array
        Dim arrExcel(frm_Records.BindingSource1.DataSource.Rows.Count, frm_Records.BindingSource1.DataSource.Columns.Count - 1) As String

        'Write header row to array
        arrExcel(0, 0) = "SSN"
        arrExcel(0, 1) = "CREATE_DATE"
        arrExcel(0, 2) = "SERVICER_CODE"
        arrExcel(0, 3) = "STATUS"
        arrExcel(0, 4) = "DRIVER_FILE_OUT"
        arrExcel(0, 5) = "LAST_UPDATE_USER"
        arrExcel(0, 6) = "LAST_UPDATE_DATE"
        arrExcel(0, 7) = "CREATE_USER"

        'Copy rows from datatable to array
        xlRow = 1
        For Each dr As DataRow In frm_Records.BindingSource1.DataSource.Rows
            arrExcel(xlRow, 0) = dr("SSN")
            arrExcel(xlRow, 1) = dr("CREATE_DATE")
            arrExcel(xlRow, 2) = dr("SERVICER_CODE")
            arrExcel(xlRow, 3) = dr("STATUS")
            If IsDBNull(dr("DRIVER_FILE_OUT")) Then
                arrExcel(xlRow, 4) = ""
            Else
                arrExcel(xlRow, 4) = dr("DRIVER_FILE_OUT")
            End If
            arrExcel(xlRow, 5) = dr("LAST_UPDATE_USER")
            arrExcel(xlRow, 6) = dr("LAST_UPDATE_DATE")
            arrExcel(xlRow, 7) = dr("CREATE_USER")
            xlRow += 1
        Next

        'Set up range
        Dim c1 As Microsoft.Office.Interop.Excel.Range = xlApp.Range("A1") 'Top left of data
        Dim c2 As Microsoft.Office.Interop.Excel.Range = xlApp.Range("T" & frm_Records.BindingSource1.DataSource.Rows.Count - 1 + xlTopRow) 'Bottom right of data
        Dim xlRange As Microsoft.Office.Interop.Excel.Range = xlApp.Range(c1, c2)

        xlRange.Value = arrExcel 'Write array to range in Excel

        xlWB.ActiveSheet.Range("A:T").Columns.Autofit()
        xlWB.ActiveSheet.Range("A1:T1").Interior.Color = RGB(255, 255, 153)
        xlWB.ActiveSheet.Range("A1:T1").Font.Bold = True

        With xlApp.ActiveWindow
            .SplitColumn = 0
            .SplitRow = 1
        End With

        xlApp.ActiveWindow.FreezePanes = True

        Dim strSheet As String

        For Each Sht In xlWB.Worksheets
            If Sht.name Like "*Sheet*" Then
                strSheet = Sht.name
                xlApp.Sheets(strSheet).delete()
            End If
        Next

        xlApp.IgnoreRemoteRequests = False

        xlWB.SaveAs(xlFile)

        xlWB.Close()

        Dim xlHWND As Integer = xlApp.Hwnd
        'this will have the process ID after call to GetWindowThreadProcessId
        Dim ProcIdXL As Integer = 0
        'get the process ID
        GetWindowThreadProcessId(xlHWND, ProcIdXL)
        'get the process
        Dim xproc As Process = Process.GetProcessById(ProcIdXL)

        xlApp.Quit()

        'Release
        System.Runtime.InteropServices.Marshal.ReleaseComObject(xlApp)



        'set to nothing
        xlApp = Nothing

        'kill it with glee
        If Not xproc.HasExited Then
            xproc.Kill()
        End If


    Catch ex As Exception
        WP.WAPC_RUNSCRIPT_ERROR_FILE(WP.argScriptName, "Error Writing to Excel Report: " & ex.Message)
        Return False
    End Try
    Return True
End Function
<DllImport("user32.dll", SetLastError:=True)> _
Private Function GetWindowThreadProcessId(ByVal hwnd As IntPtr, _
                      ByRef lpdwProcessId As Integer) As Integer
End Function
#End Region

我想要做的是在完成 Excel 文件的创建后，我想让用户选择保存新创建的文件的位置。我是新来的 Winforms，我不确定如何执行此操作。

让用户选择保存文件的最佳方式是什么？

更新： @Claudius 回答后的工作代码。

Private Sub btnRecExport_Click(sender As Object, e As EventArgs) Handles 
btnRecExport.Click 
Dim file As String = "I:\PSLFRecords.xlsx" 
CreateExcelFile(file) 
Dim sfdRecords As New SaveFileDialog() 
sfdRecords.Filter = "Excel File|*.xls" 
sfdRecords.Title = "Save PSLF Driver Records" 
sfdRecords.ShowDialog() 
If sfdRecords.FileName <> "" Then 
xlWB.SaveAs(sfdRecords.FileName) 
fs.Close() 
End If 
End Sub

【参考方案1】：

来自MSDN 已根据您的需要编辑：

Private Sub Button2_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button2.Click
   ' Displays a SaveFileDialog so the user can save the Image
   ' assigned to Button2.
   Dim saveFileDialog1 As New SaveFileDialog()
   saveFileDialog1.Filter = "Excel File|*.xls
   saveFileDialog1.Title = "Save an Excel File"
   saveFileDialog1.ShowDialog()

   ' If the file name is not an empty string open it for saving.
   If saveFileDialog1.FileName <> "" Then
       xlWB.SaveAs(saveFileDialog1.FileName)
       fs.Close()
    End If
End Sub

【讨论】：

这是我的按钮单击事件，带有您在上面编写的附加代码，Private Sub btnRecExport_Click(sender As Object, e As EventArgs) Handles btnRecExport.Click Dim file As String = "I:\PSLFRecords.xlsx " CreateExcelFile(file) Dim sfdRecords As New SaveFileDialog() sfdRecords.Filter = "Excel File|*.xls" sfdRecords.Title = "Save PSLF Driver Records" sfdRecords.ShowDialog() If sfdRecords.FileName "" Then xlWB. SaveAs(sfdRecords.FileName) fs.Close() End If End Sub

不不不，不要在评论中发布代码，编辑您的问题。

【参考方案2】：

您真正需要的只是FolderBrowserDialog Class 的一个新实例，它将返回用户选择的路径。您需要的所有信息都已包含在文档中。