时间戳

首页 > 解决方案 > 使用 vba 从共享点下载具有动态文件名的 Zip 文件

excel - 使用 vba 从共享点下载具有动态文件名的 Zip 文件

问题描述

我正在使用下面的 VBA 从 HTTPS Sharepoint 下载一个 Zip 文件，该文件也可以正常工作。

但是，问题是 zip 文件夹名称根据上周开始（星期日）和结束日（星期六）每周在 sharepoint 上不断变化。

过去两周的文件名示例

  1. 数据分析（5 月 16-22 日）.zip
  2. 数据分析（5 月 23-29 日）.zip

我正在通过 VBA excel 寻找解决方案，尽管每周更改 zip 名称，但 vba 可以工作。有人可以帮助我吗？

Option Explicit

#If Win64 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
      "URLDownloadToFileA" ( _
ByVal pCaller As LongLong, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As LongLong, _
ByVal lpfnCB As LongLong) As LongLong

#Else

Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
    "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
#End If




Sub MyMacro()

Dim strUrl As String

strUrl = "https://my.sharepoint.com/teams/WW_C2C_Reporting/Shared Documents/CO 
Reports/Data Analysis/Data Analysis (May 23-29).zip"

Dim strSavePath As String

strSavePath = "C:\Work\\New folder\" & fileName(strUrl)

If Dir(Left(strSavePath, InStrRev(strSavePath, "\")), vbDirectory) = "" Then
MsgBox "Destination folder is not found for the file:" & vbLf & strSavePath, vbCritical, 
"Error"
Exit Sub
End If

If DownLoadFile(strUrl, strSavePath) Then
MsgBox "File from:" & vbLf & strUrl & vbLf & "is saved to:" & vbLf & strSavePath
Else
MsgBox "Can't download file:" & vbLf & strUrl, vbCritical, "Error"
End If

End Sub

支持 VBA 从共享点下载 Zip 文件

Function DownLoadFile(Url As String, SavePathName As String) As Boolean
DownLoadFile = URLDownloadToFile(0, Replace(Url, "\", "/"), SavePathName, 0, 0) = 0
End Function

支持 VBA 下载共享点上具有相同文件名的 Zip 文件

Function fileName(file_fullname) As String
fileName = Mid(file_fullname, InStrRev(file_fullname, "/") + 1)
End Function

标签： excelvbasharepoint

解决方案

推荐阅读