Question

我一直在使用以下代码来检查SharePoint网站上是否存在文件：

Function URLExists(url As String) As Boolean
    Dim oXHTTP As Object
    Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
    If Not UCase(url) Like "HTTP:*" Then
        url = "http://" & url
    End If
    On Error GoTo haveError
        oXHTTP.Open "HEAD", url, False
        oXHTTP.send
        URLExists = IIf(oXHTTP.Status = 200, True, False)
    Exit Function

haveError:
        URLExists = False End Function

现在的问题是我以前下载的文件格式如下：

old url = teams.sharepoint.xyz.com\Daily Report - DDMMYYYY.XLS
new url = teams.sharepoint.xyz.com\Daily Report - v2 YYYY-MM-DD-HH-MM-SS.XLS.XLS

我希望能够从服务器获取最新文件，但我不确定如何使用通配符。以前它可以很好地使用旧网址，因为我可以轻松地格式化日期，但是现在新的网址已经添加了时间，我无法找到一种方法来搜索SharePoint网站，也许是通配符搜索。

Answer 1

我想我现在已经解决了这个问题：

   Function GetFullFileName(strfilepath As String, strFileNamePartial As String) As String
      Dim objFS As Variant
      Dim objFolder As Variant
      Dim objFile As Variant
      Dim intLengthOfPartialName As Integer
      Dim strfilenamefull As String

      Set objFS = CreateObject("Scripting.FileSystemObject")
      Set objFolder = objFS.GetFolder(strfilepath)

      'work out how long the partial file name is intLengthOfPartialName = Len(strFileNamePartial)

      'Instead of specifying the starting characters of the file you can directly loop through all files in the folder
      For Each objFile In objFolder.Files 

         'Test to see if the file matches the partial file name
         If Left(objFile.Name, intLengthOfPartialName) = strFileNamePartial Then
            'get the full file name
            strfilenamefull = objFile.Name
            Exit For
         Else

         End If
      Next objFile

      Set objFolder = Nothing
      Set objFS = Nothing

      'Return the full file name as the function's value
      GetFullFileName = strfilenamefull

   End Function

   Function URLExists(url As String) As Boolean
      Dim oXHTTP As Object
      Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
      If Not UCase(url) Like "HTTP:*" Then
         url = "http://" & url
      End If
      On Error GoTo haveError
      oXHTTP.Open "HEAD", url, False
      oXHTTP.send
      URLExists = IIf(oXHTTP.Status = 200, True, False)
   Exit Function

   haveError:
      URLExists = False 
   End Function

然后在main函数中使用以下代码：

PrtFileName = "\\sharepointsite.com\path to folder"
PrtFileName2 = "sharepointsite.com/path to folder"
' ---------------------------------------
' Check source file exists using a loop
' to keep going back until a valid file
' is found within last 7 days.
' ---------------------------------------
Dim fileExists, a As Boolean
fileExists = False
Dim dateOffset As Integer
dateOffset = 0

Do While ((fileExists = False) And (dateOffset < 14))
    FileDate = "Daily Report - Remedy v2 " + Format(Now() - dateOffset, "YYYY-MM-DD")

    Filename1 = GetFullFileName(PrtFileName, FileDate)
    MsgBox PrtFileName + "\" + Filename1

    a = URLExists(PrtFileName2 + "/" + Filename1)

    If a = True Then
        'FileDate = Now()
        Filename = PrtFileName + "\" + Filename1
        MsgBox Filename
        fileExists = True
    Else
        a = False
        fileExists = False
        dateOffset = dateOffset + 1
    End If
Loop

像魅力一样工作。要打开excel工作簿，我使用以下命令：

Dim wb2 As Workbook
Set wb2 = Workbooks.Open(Filename)

如果某人能够提高效率，那就更好了，但它暂时为我做好了工作。

在Sharepoint上搜索文件并返回文件名

1 个答案: