2016-06-01 14 views
0

ボタンクリックでデータテーブルからxlsファイルを生成しています。今、ファイルを保存するパスがファイルを生成する機能にハードコードされていますダイアログボックスで生成されたExcelファイルを保存します

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 

答えて

0

あなたが実際に必要とするだろうすべては、ユーザーが選択したパスあなたに返すよう、FolderBrowserDialog Classのちょうど新しいインスタンスです。必要なすべての情報は、すでにドキュメントに記載されています。あなたのニーズに編集したMSDNから

1

:ここ

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 
+0

は(のEventArgsとしてオブジェクトとして送信者、e)の追加上記の書いたコード、 ます。Private Sub btnRecExport_Clickと私のボタンクリックイベントbtnRecExport.Click点心を処理しています sfdRecords.Title = "保存PSLFドライバのレコード" | CreateExcelFile(ファイル)新SaveFileDialog() sfdRecords.Filter = "* .XLSエクセルファイル" と 薄暗いsfdRecords:文字列= "\ PSLFRecords.xlsx I" としてファイルsfdRecords.ShowDialog() sfdRecords.FileName <> "" 次に xlWB.SaveAs(sfdRecords.FileName) fs.Close() 終了@RandyJohnson –

+0

End Subの あれば、それは動作しますので、もし? – Claudius

+0

いいえいいえ、コメントにコードを投稿してください、あなたの質問を編集しないでください。 – Werdna

関連する問題