Excel-用本地文件夹路径替换Google的云端硬盘超链接

时间:2018-07-16 11:42:34

标签: excel drive

我有一个Excel文档,其中包含Google的照片的驱动器超链接,我想更改它们以链接我下载到文件夹中的本地照片。无需手动执行就可以吗?

超链接:https://drive.google.com/open?id=1yCSptfKRkbkN39Lkbz2yXLM0CI332_DC

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

1 个答案:

答案 0 :(得分:0)

在我看来,您正在使用来自Google驱动器的可共享链接-这意味着图像文件名在链接中不可见,因此您需要通过打开链接来找到文件名。我们可以在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

这将为我们获取您具有的链接的文件名/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工作表中保存超链接的区域。我们还将确保Excel使用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变量设置为拥有本地图像的文件夹路径