Excel - 将 Google 的驱动器超链接替换为本地文件夹路径

Excel - Replace Google's Drive hyperlinks with local folder paths

我有一个 Excel 文档,其中 Google 的驱动器 hyperlink 用于照片,我想将这些更改为 link 我在文件夹代替。这可能无需手动执行吗?

超级link : https://drive.google.com/open?id=1yCSptfKRkbkN39Lkbz2yXLM0CI332_DC

图片名称:_storage_emulated_0_odk_instances_CASA_2018-06-22_15-29-52_1529678182622.jpg

在我看来,您正在使用来自 Google 驱动器的可共享 links - 这意味着图像的文件名在 link 中不可见,因此您需要通过打开 link 来发现文件名。我们可以在 VBA 中通过调用浏览器对象来执行此操作,此处使用 Internet Explorer:

Sub GetFileName()
    Dim ie As Object
    Set ie = CreateObject("Internetexplorer.Application")
    ie.Navigate "https://drive.google.com/open?id=1yCSptfKRkbkN39Lkbz2yXLM0CI332_DC"
    While ie.busy = True 'Allow the website to load
        Application.Wait (Now + TimeValue("0:00:01"))
    Wend

    Debug.Print (ie.Document.Title)
    ie.Quit
End Sub

这为我们获取了您拥有的 link 的文件名 /storage/emulated/0/odk/instances/CASA_2018-06-22_15-29-52/1529678182622.jpg。正如您所说,您计算机上的文件名是:_storage_emulated_0_odk_instances_CASA_2018-06-22_15-29-52_1529678182622.jpg,我们使用 replace 函数将 \ 替换为 _。我们还需要删除文件名末尾的“- Google Disk”文本:

Sub GetFileName()
    Dim ie As Object
    Dim fname As String 'Saving filename as string for later use
    Set ie = CreateObject("Internetexplorer.Application")
    ie.Navigate "https://drive.google.com/open?id=1yCSptfKRkbkN39Lkbz2yXLM0CI332_DC"
    While ie.busy = True 'Allow the website to load the image (wait for 1 second if browser is busy)
        Application.Wait (Now + TimeValue("0:00:01"))
    Wend
    fname = ie.Document.Title
    ie.Quit
    fname = Replace(fname, "/", "_") 'Changing filename to fit your local file
    fname = Replace(fname, " - Google Disk", "") 'Removing the additional text from the filename
    Debug.Print (fname)
End Sub

现在我们已经可以正常工作了,我们可以遍历您 excel sheet 中保存了 hyperlink 的区域。我们还将确保 Excel 将本地文件的路径识别为 hyperlink,使用 Hyperlinks.Add:

Sub GetFileName()
    Dim ie As Object
    Dim fname As String, wlink As String, lpath As String
    lpath = "C:\Users\LocalAccount\Downloads\" 'The folder where you have the images saved
    Set ie = CreateObject("Internetexplorer.Application")
    For i = 1 To 10 'Replace 1 and 10 with your first and last row of hyperlinks
        wlink = Cells(i, 2).Value 'My links are in column B, hence "2". Change this to fit your sheet (1 for column A, 3 for Column C, etc.)
        ie.Navigate wlink
        While ie.busy = True 'Allow the website to load the image (wait for 1 second if browser is busy)
            Application.Wait (Now + TimeValue("0:00:01"))
        Wend
        fname = ie.Document.Title
        fname = Replace(fname, "/", "_")
        fname = Replace(fname, " - Google Disk", "") 'Removing the additional text from the filename
        fname = lpath + fname
        Cells(i, 2).Value = fname 'Replaces the hyperlink with the local filename
        Cells(i, 2).Hyperlinks.Add Cells(i, 2), Cells(i, 2).Value
    Next i
    ie.Quit
End Sub

这应该可以解决您的问题 - 如果您有任何问题,请告诉我。

PS:记得将 lpath 变量设置为您拥有本地图像的文件夹路径