Question

如何使用提示方法将数据从一个excel文件导入到另一个excel文件中。让用户选择路径文件，或键入excel工作簿名称。目前的代码没有成功。请指教。

' Get customer workbook...
Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook

' make weak assumption that active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook

' get the customer workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
customerFilename = Application.GetOpenFilename(filter, , caption)

Set customerWorkbook = Application.Workbooks.Open(customerFilename)

' assume range is A1 - C10 in sheet1
' copy data from customer to target workbook
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets(1)
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)

targetSheet.Range("A1", "C10").Value = sourceSheet.Range("A1", "C10").Value

' Close customer workbook
customerWorkbook.Close

Answer 1

这是一个公共函数，它使用filedialog允许用户浏览并选择要在代码中操作的文件。返回值将是所选文件的文件路径。目前设置为仅允许单个选择Public Function GetFilePath(strTitle) As String Dim fso As Object Dim varFile As Variant Dim strPath As String On Error GoTo PROC_ERR Set fso = Application.FileDialog(3) With fso .Title = strTitle .AllowMultiSelect = False .Show End With For Each varFile In fso.SelectedItems strPath = varFile Next Set fso = Nothing GetFilePath = strPath Exit Function PROC_ERR: MsgBox "Error: " & Err.Number & "; " & Err.Description GetFilePath = "Null" End Function。

' get the customer workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select an input file "
customerFilename = Application.GetOpenFilename(filter, , caption)
Set customerWorkbook = Application.Workbooks.Open(customerFilename)

所以而不是：

Set customerWorkbook = Application.Workbooks.Open(GetFilePath("Select the customer file"))

使用：

PublicClientApplication.Remove(IUser)

将数据从一个excel文件导入到另一个用户提示

1 个答案: