繁体   English   中英

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

[英]Save generated excel file with dialog

我在单击按钮时从数据表生成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

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

您实际需要的只是FolderBrowserDialog类的新实例,它将向您返回用户选择的路径。 您所需的所有信息已在文档中提供。

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM