讓用戶指定excel文件應該在vb 2010中導出的位置

Question

我有一個數據庫應用程序，它將datagridview中的數據導出爲ex​​cel。它一切正常，但我希望我的用戶指定Excel將被導出的路徑。 你能給我一些答案或提示嗎？ TIA 這裏是我的導出按鈕代碼。

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click 
    Dim columnsCount As Integer = DataGridView1.Columns.Count 

    Dim xlWorkBook As Excel.Workbook 
    Dim xlWorkSheet As Excel.Worksheet 
    Dim misValue As Object = System.Reflection.Missing.Value 

    xlWorkBook = APP.Workbooks.Add(misValue) 
    xlWorkSheet = xlWorkBook.Sheets("Sheet1") 

    For Each column In DataGridView1.Columns 
     xlWorkSheet.Cells(1, column.Index + 1).Value = column.Name 
    Next 

    For i As Integer = 0 To DataGridView1.Rows.Count - 1 
     Dim columnIndex As Integer = 0 
     Do Until columnIndex = columnsCount 
      xlWorkSheet.Cells(i + 2, columnIndex + 1).Value = DataGridView1.Item(columnIndex, i).Value.ToString 
      columnIndex += 1 
     Loop 
    Next 

    xlWorkBook.SaveAs("C:\Users\IT-PC\Desktop\Excel Files for Printing\Metal\Metal.xls", Excel.XlFileFormat.xlWorkbookNormal, misValue, misValue, misValue, misValue, _ 
    Excel.XlSaveAsAccessMode.xlExclusive, misValue, misValue, misValue, misValue, misValue) 
    xlWorkBook.Close(True, misValue, misValue) 
    APP.Quit() 

    releaseObject(xlWorkSheet) 
    releaseObject(xlWorkBook) 
    releaseObject(APP) 

    MessageBox.Show("File successfully exported!") 
End Sub 

Answer 1

添加一個模塊和粘貼下面的代碼，並使用該函數GetSaveTo（「文件名」，[「保存位置」]），如果返回=「」，則用戶具有點擊取消。

Option Explicit 

Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenFilename As OPENFILENAME) As Long 

Private Type OPENFILENAME 
    lStructSize As Long 
    hwndOwner As Long 
    hInstance As Long 
    lpstrFilter As String 
    lpstrCustomFilter As String 
    nMaxCustFilter As Long 
    nFilterIndex As Long 
    lpstrFile As String 
    nMaxFile As Long 
    lpstrFileTitle As String 
    nMaxFileTitle As Long 
    lpstrInitialDir As String 
    lpstrTitle As String 
    flags As Long 
    nFileOffset As Integer 
    nFileExtension As Integer 
    lpstrDefExt As String 
    lCustData As Long 
    lpfnHook As Long 
    lpTemplateName As String 
End Type 

Dim m_OpenFilename As OPENFILENAME 
Const MaxBuffer = 256 
Const OFN_OVERWRITEPROMPT = &H2& 



public Function GetSaveTo(ByVal fname As String, Optional ByVal InitialDir As String) As String 
    If (InitialDir = "") Then InitialDir = Environ("userprofile") 

    With m_OpenFilename 
     .lStructSize = Len(m_OpenFilename) 

     .lpstrTitle = "Save to" 
     .lpstrInitialDir = InitialDir 
     .flags = OFN_OVERWRITEPROMPT 
     .lpstrFilter = "Excel Workbook" & Chr(0) & "*.xlsx" & Chr(0) & Chr(0) 
     .nFilterIndex = 1 

     .lpstrFile = String(MaxBuffer, 0) 
     .nMaxFile = MaxBuffer - 1 
     .lpstrFileTitle = .lpstrFile 
     .nMaxFileTitle = MaxBuffer - 1 

    End With 
    If GetSaveFileName(m_OpenFilename) <> 0 Then 
     GetSaveTo = Left$(m_OpenFilename.lpstrFile, m_OpenFilename.nMaxFile) 
    End If 
End Function