根据可变的用户定义路径复制已关闭工作簿中的数据-Java 学习之路

我已经耗尽了我的搜索功能，正在寻找解决方案 . 以下是我想要做的概述：

用户打开启用宏的Excel文件
立即提示，供用户输入或选择所需工作簿的文件路径 . 他们需要选择两个文件，文件名可能不一致
输入文件位置后，第一个文件选择的第一个工作表将被复制到启用宏的工作簿的第一个工作表，第二个文件选择的第一个工作表将被复制到启用宏的第二个工作表工作簿 .

我遇到过一些ADO的引用，但我还不熟悉它 .

编辑：我找到了一个从已关闭文件导入数据的代码 . 我需要调整范围以返回变量结果 .

Private Function GetValue(path, file, sheet, ref)

    path = "C:\Users\crathbun\Desktop"
    file = "test.xlsx"
    sheet = "Sheet1"
    ref = "A1:R30"

     '   Retrieves a value from a closed workbook
    Dim arg As String

     '   Make sure the file exists
    If Right(path, 1) <> "\" Then path = path & "\"
    If Dir(path & file) = "" Then
        GetValue = "File Not Found"
        Exit Function
    End If

     '   Create the argument
    arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
    Range(ref).Range("A1").Address(, , xlR1C1)

     '   Execute an XLM macro
    GetValue = ExecuteExcel4Macro(arg)
End Function

Sub TestGetValue()

    path = "C:\Users\crathbun\Desktop"
    file = "test"
    sheet = "Sheet1"

    Application.ScreenUpdating = False
    For r = 1 To 30
        For C = 1 To 18
            a = Cells(r, C).Address
            Cells(r, C) = GetValue(path, file, sheet, a)
        Next C
    Next r

    Application.ScreenUpdating = True
End Sub

现在，我需要一个命令按钮或用户窗体，它将立即提示用户定义文件路径，并从该文件导入数据 .

2 回答

我不介意在处理期间是否打开文件 . 我只是不希望用户必须单独打开文件 . 我只需要它们就可以选择或导航到所需的文件

这是一个基本代码 . 此代码要求用户选择两个文件，然后将相关工作表导入当前工作簿 . 我有两个选择 . 拿你的选择:)

TRIED AND TESTED

OPTION 1 (Import the Sheets directly instead of copying into sheet1 and 2)

Option Explicit

Sub Sample()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim Ret1, Ret2

    Set wb1 = ActiveWorkbook

    '~~> Get the first File
    Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Please select first file")
    If Ret1 = False Then Exit Sub

    '~~> Get the 2nd File
    Ret2 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Please select Second file")
    If Ret2 = False Then Exit Sub

    Set wb2 = Workbooks.Open(Ret1)
    wb2.Sheets(1).Copy Before:=wb1.Sheets(1)
    ActiveSheet.Name = "Blah Blah 1"
    wb2.Close SaveChanges:=False

    Set wb2 = Workbooks.Open(Ret2)
    wb2.Sheets(1).Copy After:=wb1.Sheets(1)
    ActiveSheet.Name = "Blah Blah 2"
    wb2.Close SaveChanges:=False

    Set wb2 = Nothing
    Set wb1 = Nothing
End Sub

OPTION 2 (Import the Sheets contents into sheet1 and 2)

Option Explicit

Sub Sample()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim Ret1, Ret2

    Set wb1 = ActiveWorkbook

    '~~> Get the first File
    Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Please select first file")
    If Ret1 = False Then Exit Sub

    '~~> Get the 2nd File
    Ret2 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Please select Second file")
    If Ret2 = False Then Exit Sub

    Set wb2 = Workbooks.Open(Ret1)
    wb2.Sheets(1).Cells.Copy wb1.Sheets(1).Cells
    wb2.Close SaveChanges:=False

    Set wb2 = Workbooks.Open(Ret2)
    wb2.Sheets(1).Cells.Copy wb1.Sheets(2).Cells
    wb2.Close SaveChanges:=False

    Set wb2 = Nothing
    Set wb1 = Nothing
End Sub

回复于 2024-05-03T15:02:02+08:00

下面的函数从已关闭的Excel文件中读取数据并将结果返回到数组中 . 它会丢失格式，公式等 . 您可能希望在主代码中调用isArrayEmpty函数（在底部）来测试函数返回的内容 .

Public Function getDataFromClosedExcelFile(parExcelFileName As String, parSheetName As String) As Variant
'see http://www.ozgrid.com/forum/showthread.php?t=19559
'returns an array (1 to nRows, 1 to nCols) which should be tested with isArrayEmpty in the calling function

  Dim locConnection As New ADODB.Connection
  Dim locRst As New ADODB.Recordset
  Dim locConnectionString As String
  Dim locQuery As String
  Dim locCols As Variant
  Dim locResult As Variant
  Dim i As Long
  Dim j As Long

  On Error GoTo error_handler

  locConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
  & "Data Source=" & parExcelFileName & ";" _
  & "Extended Properties=""Excel 8.0;HDR=YES"";"

  locQuery = "SELECT * FROM [" & parSheetName & "$]"

  locConnection.Open ConnectionString:=locConnectionString
  locRst.Open Source:=locQuery, ActiveConnection:=locConnection
  If locRst.EOF Then 'Empty sheet or only one row
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''         FIX: an empty sheet returns "F1"
    ''''''         http://support.microsoft.com/kb/318373
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If locRst.Fields.Count = 1 And locRst.Fields(0).Name = "F1" Then Exit Function 'Empty sheet
    ReDim locResult(1 To 1, 1 To locRst.Fields.Count) As Variant
    For i = 1 To locRst.Fields.Count
      locResult(1, i) = locRst.Fields(i - 1).Name
    Next i
  Else
    locCols = locRst.GetRows
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''         FIX: an empty sheet returns "F1"
    ''''''         http://support.microsoft.com/kb/318373
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If locRst.Fields.Count = 1 And locRst.Fields(0).Name = "F1" And UBound(locCols, 2) = 0 And locCols(0, 0) = "" Then Exit Function 'Empty sheet

    ReDim locResult(1 To UBound(locCols, 2) + 2, 1 To UBound(locCols, 1) + 1) As Variant

    If locRst.Fields.Count <> UBound(locCols, 1) + 1 Then Exit Function 'Not supposed to happen

    For j = 1 To UBound(locResult, 2)
      locResult(1, j) = locRst.Fields(j - 1).Name
    Next j
    For i = 2 To UBound(locResult, 1)
      For j = 1 To UBound(locResult, 2)
        locResult(i, j) = locCols(j - 1, i - 2)
      Next j
    Next i
  End If

  locRst.Close
  locConnection.Close
  Set locRst = Nothing
  Set locConnection = Nothing

  getDataFromClosedExcelFile = locResult

  Exit Function
error_handler:
  'Wrong file name, sheet name, or other errors...
  'Errors (#N/A, etc) on the sheet should be replaced by Null but should not raise an error
  If locRst.State = ADODB.adStateOpen Then locRst.Close
  If locConnection.State = ADODB.adStateOpen Then locConnection.Close
  Set locRst = Nothing
  Set locConnection = Nothing

End Function

Public Function isArrayEmpty(parArray As Variant) As Boolean
'Returns false if not an array or dynamic array that has not been initialised (ReDim) or has been erased (Erase)

  If IsArray(parArray) = False Then isArrayEmpty = True
  On Error Resume Next
  If UBound(parArray) < LBound(parArray) Then isArrayEmpty = True: Exit Function Else: isArrayEmpty = False

End Function

样品用途：

Sub test()

  Dim data As Variant

  data = getDataFromClosedExcelFile("myFile.xls", "Sheet1")
  If Not isArrayEmpty(data) Then
    'Copies content on active sheet
    ActiveSheet.Cells(1,1).Resize(UBound(data,1), UBound(data,2)) = data
  End If

End Sub

回复于 2024-05-03T15:02:02+08:00

根据可变的用户定义路径复制已关闭工作簿中的数据

2 回答

相关问题