Note – I am not responsible for any problems that may arise from using a macro!
Online is beautiful, but perishable. Today, you see it “live”, tomorrow, it may not be there.
Let’s say you want to mass download some links / pages / web sites to have them as a backup copy. How to do it?
(note – make sure you have the right to save things I talk about below, not everything which is available online is suitable for saving, you might break some rules / laws if you save things without looking at terms & conditions)
If you want to download a whole web site, have a look at:
If you want to crawl a web site, have a look at (it crawls a web site and, at the end, it generates a list of all the links on the web site):
- Free: Find broken links on your site with Xenu’s Link Sleuth (TM)
- Premium: Screaming Frog: SEO, Search Engine Optimisation & Marketing
- Premium-er: DeepCrawl – Delivering SEO Confidence
How to download videos from a web site (atypical solution, it’s not what you might be expecting)?
Let’s say you quickly want to open lots of links (then copy / save the information):
or to copy the URLs from the browser to somemplace else:
- Copy All Urls – Chrome Web Store (there similar extensions for other browsers)
Let’s say you want to open for download 500 links, one after the other, in browser. How do you make them open one by one? Have a look at:
- Multi Open :: Add-ons for Firefox (it alows to slowly open links, one by one)
If you want to save an article with the following formatting:
title
content
final link,
OLD: I suggest you give a chance to the Microsoft Word macro below.
NEW, 2021.10.30: I suggest you give a chance to the Microsoft Word macro below (DOWNLOAD HERE!).
You just need to copy an article from the Internet, the first line should be a title, then the content, and, at the end, the URL to the article.
When you run the macro, it automatically saves it using the title of the article, and it “pretty” formats it.
How to install a Macro for Word? Details #1 ». Details #2.
NEW, 2021.10.30:
Sub Format_text()
‘
‘ Format_text Macro
‘
‘
Selection.HomeKey Unit:=wdStory
If Selection.Information(wdWithInTable) Then
Selection.Rows.ConvertToText Separator:=wdSeparateByParagraphs, _
NestedTables:=True
End If
Selection.HomeKey Unit:=wdStory
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Font.Size = 14
Selection.WholeStory
Selection.Font.Name = “Verdana”
With Selection.Font.Shading
.Texture = wdTextureSolid
.ForegroundPatternColor = -603914241
.BackgroundPatternColor = -603914241
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With
Selection.HomeKey Unit:=wdStory
Selection.WholeStory
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
Selection.Shading.Texture = wdTextureNone
Selection.Shading.ForegroundPatternColor = wdColorAutomatic
Selection.Shading.BackgroundPatternColor = wdColorAutomatic
With Selection.Font.Shading
.Texture = wdTextureSolid
.ForegroundPatternColor = -603914241
.BackgroundPatternColor = -603914241
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With
Selection.WholeStory
Options.DefaultHighlightColorIndex = wdNoHighlight
Selection.Range.HighlightColorIndex = wdNoHighlight
Selection.Font.Color = wdColorAutomatic
Selection.ParagraphFormat.LineSpacing = LinesToPoints(1.15)
With Selection.ParagraphFormat
.SpaceBefore = 4
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.LineUnitBefore = 1
End With
Selection.HomeKey Unit:=wdStory
Selection.Paragraphs(1).Range.Select
Selection.Font.Size = 1
Selection.HomeKey Unit:=wdStory
Dim Ziua2 As String
Ziua2 = Day(Date)
Ziua2 = Format(Ziua2, “Long Date”)
Dim Luna2 As String
Luna2 = Format(“mm”)
Dim Anul2 As String
Anul2 = Year(Date)
‘Selection.TypeText Text:=Anul2 + “.” + Luna2 + “.” + Ziua2 + ” ”
‘Selection.TypeText Text:=Format(“mm.dd.yyyy”)
Selection.InsertDateTime DateTimeFormat:=”yyyy.MM.dd “, InsertAsField:= _
False, DateLanguage:=wdEnglishUK, CalendarType:=wdCalendarWestern, _
InsertAsFullWidth:=False
Selection.HomeKey Unit:=wdStory
Dim c As String
c = Format(DateTime.Now(), “YYYY.MM.DD”)
Data2 = c
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = Data2 + ” ” + Data2
.Replacement.Text = Data2
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.HomeKey Unit:=wdStory
With Selection
‘To top of document
.HomeKey Unit:=wdStory
End With
Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Range.Case = wdTitleWord
Dim selBkUp As Range
Set selBkUp = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End)
Dim MyFileName As String
MyFileName = AlphaNumericOnly(Left(CStr(selBkUp), 150) & “.docx”)
‘ Selection.Copy
‘ You can un-comment this line, if you wish to copy the filename to the clipboard
ActiveDocument.Undo
Selection.Font.Size = 26
Selection.HomeKey Unit:=wdStory
Dim CurrentDirectoryPlusFile As String
CurrentDirectoryPlusFile = “C:\Users\olivi\Desktop\” & MyFileName
ActiveDocument.SaveAs2 FileName:=CurrentDirectoryPlusFile, FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:=””, AddToRecentFiles _
:=True, WritePassword:=””, ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=15
ActiveWindow.Close
‘ You can delete this line if you find that you need to make changes to the document more often than not and review how the document looks like
End Sub
OLD:
Function AlphaNumericOnly(strSource As String) As String
‘via https://stackoverflow.com/questions/15723672/how-to-remove-all-non-alphanumeric-characters-from-a-string-except-period-and-sp
Dim i As Integer
Dim strResult As String
For i = 1 To Len(strSource)
Select Case Asc(Mid(strSource, i, 1))
Case 32, 44, 45, 46, 48 To 57, 65 To 90, 97 To 122: ‘include 32 if you want to include space
strResult = strResult & Mid(strSource, i, 1)
End Select
Next
AlphaNumericOnly = strResult
End Function
Sub Format_text()
‘
‘ Format_text Macro
‘
‘
Selection.HomeKey Unit:=wdStory
If Selection.Information(wdWithInTable) Then
Selection.Rows.ConvertToText Separator:=wdSeparateByParagraphs, _
NestedTables:=True
End If
Selection.HomeKey Unit:=wdStory
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Font.Size = 14
Selection.WholeStory
Selection.Font.Name = “Verdana”
With Selection.Font.Shading
.Texture = wdTextureSolid
.ForegroundPatternColor = -603914241
.BackgroundPatternColor = -603914241
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With
Selection.HomeKey Unit:=wdStory
Selection.WholeStory
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
Selection.Shading.Texture = wdTextureNone
Selection.Shading.ForegroundPatternColor = wdColorAutomatic
Selection.Shading.BackgroundPatternColor = wdColorAutomatic
With Selection.Font.Shading
.Texture = wdTextureSolid
.ForegroundPatternColor = -603914241
.BackgroundPatternColor = -603914241
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With
Selection.WholeStory
Options.DefaultHighlightColorIndex = wdNoHighlight
Selection.Range.HighlightColorIndex = wdNoHighlight
Selection.Font.Color = wdColorAutomatic
Selection.ParagraphFormat.LineSpacing = LinesToPoints(1.15)
With Selection.ParagraphFormat
.SpaceBefore = 4
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.LineUnitBefore = 1
End With
Selection.HomeKey Unit:=wdStory
Selection.Paragraphs(1).Range.Select
Selection.Font.Size = 1
Selection.HomeKey Unit:=wdStory
Dim Ziua2 As String
Ziua2 = Day(Date)
Ziua2 = Format(Ziua2, “Long Date”)
Dim Luna2 As String
Luna2 = Format(“mm”)
Dim Anul2 As String
Anul2 = Year(Date)
‘Selection.TypeText Text:=Anul2 + “.” + Luna2 + “.” + Ziua2 + ” “
‘Selection.TypeText Text:=Format(“mm.dd.yyyy”)
Selection.InsertDateTime DateTimeFormat:=”yyyy.MM.dd “, InsertAsField:= _
False, DateLanguage:=wdEnglishUK, CalendarType:=wdCalendarWestern, _
InsertAsFullWidth:=False
Dim Data2 As String
Selection.HomeKey Unit:=wdStory
With Selection
‘To top of document
.HomeKey Unit:=wdStory
End With
Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Range.Case = wdTitleWord
With Selection.Find
.Text = “[!a-zA-Z0-9. ,]”
.Replacement.Text = “”
.Forward = False
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Dim selBkUp As Range
Set selBkUp = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End)
Dim MyFileName As String
MyFileName = AlphaNumericOnly(Left(CStr(selBkUp), 150) & “.docx”)
‘ Selection.Copy
‘ You can un-comment this line, if you wish to copy the filename to the clipboard
ActiveDocument.Undo
Selection.Font.Size = 26
Selection.HomeKey Unit:=wdStory
Dim CurrentDirectoryPlusFile As String
CurrentDirectoryPlusFile = “C:\Users\olivian\Desktop\” & MyFileName
ActiveDocument.SaveAs2 FileName:=CurrentDirectoryPlusFile, FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:=””, AddToRecentFiles _
:=True, WritePassword:=””, ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=15
ActiveWindow.Close
‘ You can delete this line if you find that you need to make changes to the document more often than not and review how the document looks like
End Sub
I’ve found Wayback Machine – web.archive.org very useful whenever a great article / website / even clip disappeared online or I wanted to re-view the old version of a website.
Good tip! Thanks!