我想通过单击图像使用 VBA 将本地文件复制到共享点库。现在我似乎无法检查 SharePoint 上的文件夹和文件。
每次我运行代码(通过单击 Excel 中的图像)时,它都会返回无法在 SharePoint 中找到该文件。并在返回 MsgBox 时停止
Sorry there's no such Folder......
我尝试了映射驱动器,它工作得很好,但不是一个选项,因为最终用户需要自己映射驱动器。 所以现在我希望使用该链接连接到 SharePoint。
如果我使用
\
将 SharePointLink 复制到 IE 和 Chrome,则效果很好。但如果我使用/
,IE将无法找到链接。
更新
如果我尝试几次后使用
\
,IE将在NetWork中打开文件路径。 Chrome 将在 Chrome 页面上显示文件路径。为什么会出现这样的情况??????
身份验证使用 Windows 身份验证,因此不是问题。
这是我的代码
Sub imgClicked()
Dim SharePointLib As String
Dim MyPath As String
Dim folderPath As String
Dim objNet As Object
Dim FSO As Object
Dim copyPath As String
Dim copyFilePath As String
folderPath = Application.ThisWorkbook.path
MyPath = Application.ThisWorkbook.FullName
SharePointLib = "//company.com/sites/MS/10%20Mg%20Review/"
' create new folder to store the file
copyPath = folderPath + "\copyPath\"
If Not FolderExists(copyPath) Then
FolderCreate (copyPath)
ElseIf Not FolderExists(SharePointLib) Then
MsgBox "Sorry there's no such folder. Folder Path: " & vbNewLine & vbNewLine & SharePointLib & ""
Exit Sub
End If
fileName = "hello.xlsm"
'Copy current excel file and save at the new folder created
ThisWorkbook.SaveCopyAs copyPath & fileName
MsgBox "Save Copy As: " + copyPath & filseName & vbNewLine & vbNewLine & "The file will be uploaded to this address: " + SharePointLib & fileName
' Check whether the file exist in the directory
' If exist error message
' else copy the file from copyPath then paste at the SharePoint directory
If Not Dir(SharePointLib & fileName, vbDirectory) = nbNullString Then
MsgBox "Sorry file already exist!"
Else
Call FileCopy(copyPath & fileName, SharePointLib & fileName)
MsgBox "File has being successfuly created in SharePoint!"
End If
Set FSO = CreateObject("scripting.filesystemobject")
If Right(copyPath, 1) = "\" Then
copyPath = Left(copyPath, Len(copyPath) - 1)
End If
If FSO.FolderExists(copyPath) = False Then
MsgBox copyPath & " doesn't exist"
Exit Sub
End If
FSO.DeleteFolder copyPath
MsgBox "Folder has being deleted successfully!"
End Sub
检查文件夹是否存在的功能
Function FolderExists(ByVal path As String) As Boolean
FolderExists = False
Dim FSO As New FileSystemObject
If FSO.FolderExists(path) Then FolderExists = True
End Function
创建文件夹功能
Function FolderCreate(ByVal path As String) As Boolean
FolderCreate = True
Dim FSO As New FileSystemObject
try:
If FSO.FolderExists(path) Then
Exit Function
Else
On Error GoTo catch
FSO.CreateFolder path
Debug.Print "FolderCreate: " & vbTab & path
Exit Function
End If
catch:
MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
FolderCreate = False
Exit Function
End Function
如有任何帮助和建议,我们将不胜感激。如果需要更多信息,请告诉我。预先感谢。
确保
WebClient
服务正在运行。您可以通过代码启动WebClient
服务,也可以将启动类型设置为自动。
随着
WebClient
服务的运行,您的文件夹/文件测试将按预期工作。
编辑:此外,如果您将共享点 URL 映射到驱动器盘符,Windows 将启动
WebClient
服务。
Sub mapPath(str_drive as string, str_path as string)
If Not Len(str_drive) = 1 Then Exit Sub
Dim wso As Object
Set wso = CreateObject("WScript.Network")
wso.MapNetworkDrive str_drive & ":", str_path, False
End Sub
为什么不暂时为他们映射驱动器?
Sub CreateFolderInSharePointAndUnmount()
Dim network As Object
Dim folderPath As String
Dim folderName As String
Dim driveLetter As String
Dim fs As Object
' Create instance of WScript.Network object
Set network = CreateObject("WScript.Network")
' Specify the SharePoint site URL
Dim sharepointURL As String
sharepointURL = "https://your_sharepoint_site_url_here/sites/your_site_name_here/library_name"
' Specify the drive letter to map
driveLetter = "Z:" ' Change this to your preferred drive letter
' Map the SharePoint document library to a network drive
On Error Resume Next
network.MapNetworkDrive driveLetter, sharepointURL
If Err.Number <> 0 Then
MsgBox "Failed to map network drive. Error: " & Err.Description, vbCritical
GoTo UnmapDrive
End If
On Error GoTo 0
' Specify the folder path within the mapped drive
folderPath = driveLetter & "\Test"
' Check if the folder already exists
If Dir(folderPath, vbDirectory) <> "" Then
MsgBox "Folder already exists.", vbExclamation
GoTo UnmapDrive
End If
' Create the folder
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CreateFolder folderPath
' Check if folder creation was successful
If Dir(folderPath, vbDirectory) <> "" Then
MsgBox "Folder created successfully.", vbInformation
Else
MsgBox "Failed to create folder.", vbCritical
GoTo UnmapDrive
End If
UnmapDrive:
' Unmap the network drive
network.RemoveNetworkDrive driveLetter, True, True
' Clean up objects
Set network = Nothing
Set fs = Nothing
End Sub`