让用户指定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