Jak pobrać adresy hiperłącz z arkusza programu Excel?

Skrypciarze odpowiadają na Wasze pytania

Jak pobrać adresy hiperłącz z arkusza programu Excel?

Cześć, Skrypciarze! W jednym z dokumentów programu Excel mam hiperłącze prowadzące do adresu email. Tekst w arkuszu to po prostu Yes. Czy istnieje jakiś skrypt, który pobiera ten adres email?

-- AK

Cześć, AK! Ostatnio pisałem o nagrodzie Nobla z literatury przyznanej w tym roku pani Lessing i chyba przez roztargnienie zupełnie zapomniałem wstawić link, na szczęście AK przypomniał mi trochę swoim pytaniem o moim haniebnym zaniedbaniu. Już nadrabiam, nasi czytelnicy na pewno interesują się literaturą, skoro czytają tak literacko przednie artykuły, jak nasze. Proszę bardzo, tu możecie się doszkolić: 2007 Nobel Prize for Literature (j.ang.). Na pewno ta wiedza pomoże Wam w grach typu Trivial Pursuit i nie dacie się zaskoczyć jak ja, gdy natknąłem się na tak oczywiste pytanie jak:

„Do jakiego rzędu należą: czerwończyk dukacik, pokapek dwukropiaczek i fruczak gołąbek?”

Chyba jestem mało inteligentny, ale zdębiałem zupełnie. Na szczęście dale Ciebie, AK, myślę, że jestem za to w stanie odpowiedzieć na pytanie: „Jak napisać skrypt, który zwraca informację na temat hiperłącz zawartych w arkuszu programu Excel?” Myślę, że w taki sposób:

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True



Set objWorkbook = objExcel.Workbooks.Open("C:\Scripts\Test.xls")

Set objWorksheet = objWorkbook.Worksheets(1)



Set colLinks = objWorksheet.Hyperlinks



For Each objLink in colLinks

    Wscript.Echo "Displayed text: " & objLink.TextToDisplay

    Wscript.Echo "Hyperlink: " & objLink.Address

    Wscript.Echo

Next

Już tłumaczę. Zaczynamy od utworzenia wystąpienia obiektu Excel.Application i ustawiamy jego właściwość Visible na True; daje nam to otwarte i widoczne na ekranie wystąpienie programu Excel. Następnie używamy poniższych dwóch wierszy kodu w celu otworzenia pliku C:\Scripts\Test.xls, po czym łączymy się z pierwszym skoroszytem w pliku:

Set objWorkbook = objExcel.Workbooks.Open("C:\Scripts\Test.xls")

Set objWorksheet = objWorkbook.Worksheets(1)

Po utworzeniu odwołania do obiektu skoroszytu, pobieramy kolekcję wszystkich hiperłącz za pomocą poniższego wiersza kodu:

Set colLinks = objWorksheet.Hyperlinks

Następnie ustawiamy pętlę For Each, która przechodzi przez całą kolekcję hiperłącz. Wewnątrz pętli musimy tylko wywołać echo wartości właściwości TextToDisplay oraz Address:

Wscript.Echo "Displayed text: " & objLink.TextToDisplay

Wscript.Echo "Hyperlink: " & objLink.Address

Co z kolei daje nam następujący wynik:

Displayed text: Hey, Scripting Guy!

Hyperlink: https://www.microsoft.com/technet/scriptcenter/resources/qanda/default

.mspx



Displayed text: Yes

Hyperlink: mailto:scripter@microsoft.com?subject=Test

Co prawda, otrzymane adresy email wyglądają trochę dziwnie, ale jeżeli stanowi to dla Was jakiś problem, to można użyć naszej pętli For Each (nie będziemy tu wchodzić w szczegóły z wyjaśnieniami):

For Each objLink in colLinks

    Wscript.Echo "Displayed text: " & objLink.TextToDisplay

    strLink = objLink.Address

    strLink = Replace(strLink, "mailto:", "")

    arrLinks = Split(strLink, "?")

    Wscript.Echo "Hyperlink: " & arrLinks(0)

    Wscript.Echo

Next

Używamy tu funkcji Replace, która zastępuje wszystkie wystąpienia wartości ciągu mailto:. Następnie korzystamy z funkcji Split, która rozdziela hiperłącze, używając znaku zapytania jako delimitera. To oddziela dany adres email od wiersza tematu.(Co zrobić, jeżeli mamy do czynienia ze starym dobrym URL-em i nie ma tam znaku zapytania? Żaden problem, otrzymana tablica będzie po prostu jednoelementowa, a tym jedynym elementem będzie właśnie URL). Po tych wszystkich operacjach przywołujemy echo wartości pierwszego elementu tablicy, który powinien wyglądać w następujący sposób:

scripter@microsoft.com

Tylko tyle.

Teraz pokażemy jeszcze jeden trick, który można zastosować, bawiąc się z hiperłączami w arkuszach programu Excel. Poniższy skrypt przechodzi przez arkusz, pobiera wszystkie hiperłącza, a następnie otwiera każdy z nich w nowym oknie:

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True



Set objWorkbook = objExcel.Workbooks.Open("C:\Scripts\Test.xls")

Set objWorksheet = objWorkbook.Worksheets(1)



Set colLinks = objWorksheet.Hyperlinks



For Each objLink in colLinks

    objLink.Follow(True)

Next

Ten skrypt różni się od poprzedniego tylko w momencie, w którym pojawia się pętla For Each. W pierwotnej pętli For Each wywoływaliśmy echo wartości właściwości dla każdego linku w skoroszycie. Tym razem wywołujemy metodę Follow, która otwiera nam każdy link w nowym oknie:

For Each objLink in colLinks

    objLink.Follow(True)

Next

Skąd wiemy, ze każdy z tych linków zostanie otwarty w nowym oknie? Ponieważ ustawiliśmy parametr NewWindow (pierwszy z kilku opcjonalnych parametrów metody Follow) na True:

Dziś mamy dzień dobroci, oto bowiem kolejny skrypt w prezencie, który, tym razem, pobiera wszystkie hiperłącza z danego arkusza i dodaje je do folderu Ulubione w programie Internet Explorer:

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True



Set objWorkbook = objExcel.Workbooks.Open("C:\Scripts\Test.xls")

Set objWorksheet = objWorkbook.Worksheets(1)



Set colLinks = objWorksheet.Hyperlinks



For Each objLink in colLinks

    objLink.AddToFavorites

Next

Jest bardzo podobny do poprzedniego, jedyną różnicą jest tu zastosowana metoda, tym razem AddToFavorites, a nie Follow.

Mamy nadzieję, że to odpowiada na Twoje pytanie, AK. Co zaś tyczy się pytania: „Do jakiego rzędu należą: czerwończyk dukacik, pokapek dwukropiaczek i fruczak gołąbek?” to są to oczywiście (nie oczywiście, nie domyśliłem się tak naprawdę) Lepidoptera (łac.).

Dla ułatwienia: „Panie Kazimierzu, motyla noga!”

Tak, to rząd: nogi.

Do początku strony