Question

我正在尝试在Excel文档中运行一个宏，该文档复制标准化时间表（其他Excel文档）中的值并将它们粘贴到SharePoint中的原始启用宏的电子表格（Zmaster文件）中。

代码在我的本地驱动器中运行，但在主文件和所有其他时间表电子表格都在SharePoint中时却无效。

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Filepath = "//hub.bcu.ac.uk/sites/rie/cdc-work-area/Timesheet Test RESTRICTED Access"
MyFile = Dir(Filepath)

Do While Len(MyFile) > 0

    If MyFile = "Zmaster.xlsx" Then
        Exit Sub
    End If

    Workbooks.Open (Filepath & MyFile)
    Range("A59:AF59").Copy
    ActiveWorkbook.Close

    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

    ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 35))

    MyFile = Dir

Loop

Range("D1").Select
MsgBox "Process is Complete!"

End Sub

在SharePoint的Zmaster文档中，我得到了＆＃34;过程完成＆＃34;没有任何转移的消息。

Answer 1

我认为你的主要问题是你写地址的方式。因此，如果您尝试在线访问，我会添加三条Replace()行来修改您的地址。由于我不确定您要查找的文件夹的位置在哪里或可以访问它，请对是否重写您的地址或使用以下代码进行判断。

我已经在我的SharePoint和本地硬盘驱动器上使用文件夹路径测试了下面的代码，它可以访问它并遍历目录。

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow As Long
Dim Filepath As String

'Your folder address
Filepath = "//hub.bcu.ac.uk/sites/rie/cdc-work-area/Timesheet Test RESTRICTED Access/"

'Amend address
    Filepath = Replace(Filepath, "/", "\")
    Filepath = Replace(Filepath, "https:", "")
    Filepath = Replace(Filepath, " ", "%20")

MyFile = Dir(Filepath)

Do While Len(MyFile) > 0
    If MyFile = "Zmaster.xlsx" Then
        Exit Sub
    End If

    Workbooks.Open (Filepath & MyFile)

    'Put your copy paste code here

    MyFile = Dir
Loop

Range("D1").Select
MsgBox "Process is Complete!"

End Sub

Answer 2

以为我发布了最接近我的答案的代码，下面的代码运行并且可以正常运行，但是只有它在文件夹中看到的第一个文件并将值粘贴到Zmaster文件中。

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow As Long
Dim Filepath As String
Dim Filepath2 As String
'Your folder address
Filepath = "//hub.bcu.ac.uk/sites/rie/cdc-work-area/Timesheet Test  RESTRICTED Access/"

'Amend address
Filepath = Replace(Filepath, "/", "\")
Filepath = Replace(Filepath, "https:", "")
Filepath = Replace(Filepath, " ", "%20")

MyFile = Dir(Filepath)

Do While Len(MyFile) > 0
If MyFile = "Zmaster.xlsm" Then
    Exit Sub
End If
Filepath2 = "https://hub.bcu.ac.uk/sites/rie/cdc-work-area/Timesheet Test  RESTRICTED Access/"
Workbooks.Open (Filepath2 & MyFile)

Range("A59:AF59").Copy
ActiveWorkbook.Close

erow = Worksheets("Sheet1").Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Row

ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 35))

MyFile = Dir

Loop

Range("D1").Select
MsgBox "Process is Complete!"

End Sub

任何想法如何将它变成一个循环，以便它现在获取所有文件。经过10天和无尽的不眠之夜，我在隧道尽头看到了光明。

再次感谢你的帮助Genie

将数据从多个工作簿传输到SharePoint中的主工作簿

2 个答案: