VBA ～お気に入りにあるURLの一覧を作成（IEのみ）～

お気に入りにあるURLの一覧を作成（IEのみ）

お気に入りがあるパスを指定して、お気に入りにあるサイトの名前とURLをエクセルに一覧にして作成します。
A2から下のセル→お気に入りにあるサイトの名前
B2から下のセル→お気に入りにあるURL
C2→お気に入りが入っているフォルダのパス
※お気に入りのパスはInternet Explorerのお気に入りを開き、お気に入りに登録されているサイト名を右クリックでプロパティを開いてください。
そして、タブの全般を選び、その中にある「場所：」がお気に入りのパスになります。

---------------------------------------------------------------------------------------
'urlファイルを読み込むメソッド
Private Declare Function GetPrivateProfileString Lib "kernel32" _
　　Alias "GetPrivateProfileStringA" _
　　 (ByVal lpApplicationName As String, _
　　ByVal lpKeyName As Any, ByVal lpDefault As String, _
　　ByVal lpReturnedString As String, ByVal nSize As Long, _
　　ByVal lpFileName As String) As Long


Private Sub CommandButton1_Click()
　　Dim path As String
　　Dim File As String

　　'お気に入りのパス
　　 path = Trim(Cells(2, 3))

　　'表示するファイル名を取得
　　 File = Dir(path & "\*", vbNormal)

　　 Dim i As Integer
　　 i = 2

　　 'ファイル名一覧を作成
　　 Do While File <> ""
　　　　 'A2から下に一覧を表示
　　　　 Cells(i, 1).Value = File
　　　　 i = i + 1
　　　　 File = Dir()
　　 Loop

　　 'ファイル名からURLを取得
　　 Dim buf As String * 256

　　 i = 2
　　 Do While Cells(i, 1) <> ""
　　　　 'セクション： InternetShortcut
　　　　 'キー： URL
　　　　 '既定値： ""
　　　　 'INIファイル名： path & "\" & Cells(i, 1)
　　　　 rc = GetPrivateProfileString _
　　　　　　 ("InternetShortcut", "URL", "", buf, Len(buf), path & "\" & Cells(i, 1))
　　　　Cells(i, 2).Value = Left$(buf, InStr(buf, vbNullChar) - 1)
　　　　 'urlという拡張子の文字列を消去
　　　　Cells(i, 1) = Replace(Cells(i, 1), ".url", "")
　　　　 'ハイパーリンクにする
　　　　 ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 2), Address:=Cells(i, 2)

　　　　 i = i + 1
　　 Loop

　　 '終了
　　 MsgBox ("作成完了！！")

End Sub

---------------------------------------------------------------------------------------
例

VBA ～フォルダ内のファイル一覧の作成～

フォルダ内のファイル一覧の作成

A2から下に指定したフォルダ内にあるファイル名やフォルダ名を表示させます。
B2にはパス、C3には拡張子、D4には属性を記入し（パス以外は空欄でも大丈夫です）ボタンを押します。

---------------------------------------------------------------------------------------

Private Sub CommandButton1_Click()
　　Dim path As String
　　Dim FileType As String
　　Dim File As String
　　Dim FileAttribute As VbFileAttribute

　　'フォルダのパス
　　path = Trim(Cells(2, 2)) & "\"

　　'属性の設定 セルのD2に対象の属性を書いておく。何もなければ標準ファイルになる
　　FileAttribute = GetFileAttribute(Trim(Cells(2, 4)))

　　'フォルダ名の表示以外は拡張子を設定
　　If FileAttribute <> vbDirectory Then
　　　　 FileType = "*"
　　　　 '拡張子がない場合はファイルすべてが対象 セルはC2
　　　　 If Trim(Cells(2, 3)) <> "" Then
　　　　　　 FileType = FileType & "." & Trim(Cells(2, 3))
　　　　 End If
　　 End If

　　 '表示するファイル名を取得
　　 File = Dir(path & FileType, FileAttribute)

　　 Dim i As Integer
　　 i = 2

　　 'ファイル名一覧を作成
　　Do While File <> ""
　　 　　'上の階層のフォルダは非表示
　　　　 If File <> ".." And File <> "." Then
　　　　　　'フォルダの表示を選択した場合、ファイル名は表示しない
　　　　　　If InStr(File, ".") <> 0 And FileAttribute = vbDirectory Then
　　　　　　Else
　　　　　　　　 'A2から下に一覧を表示
　　　　 　　　　Cells(i, 1).Value = File
　　　　 　　　　i = i + 1
　　　　　　End If
　　　　 End If
　　　　 File = Dir()
　　 Loop

　　 MsgBox ("作成完了！！")

End Sub

Private Function GetFileAttribute(FileAttribute As String) As VbFileAttribute
　　 '属性の設定
　　Select Case FileAttribute
　　　　Case "標準ファイル"
　　　　　　GetFileAttribute = vbNormal
　　　　Case "読み取り専用"
　　　　　　GetFileAttribute = vbReadOnly
　　　　Case "隠しファイル"
　　　　　　GetFileAttribute = vbHidden
　　　　Case "システムファイル"
　　　　　　GetFileAttribute = vbSystem
　　　　Case "ボリュームラベル"
　　　　　　GetFileAttribute = vbVolume
　　　　Case "フォルダ"
　　　　　　GetFileAttribute = vbDirectory
　　　　Case Else
　　　　　　GetFileAttribute = vbNormal
　　End Select
End Function

---------------------------------------------------------------------------------------
例

VBA

・フォルダを作る
・フォルダ内のファイル一覧の作成
・お気に入りにあるURLの一覧を作成（IEのみ）

バッチ

・連番でフォルダを作る

VBA ～フォルダを作る～

フォルダを作る

セルのA2からA30までに作りたいフォルダ名を書きます。
セルのA4にパスを書きます。
あと、エクセルのシートにボタンを挿入して、下のプログラムと対応ずければOK！！


---------------------------------------------------------------------------------------
Private Sub btnMakeDir_Click()
　　 Dim path As String
　　 Dim notUse As Variant

　　 'パス
　　 path = Trim(Cells(2, 4)) & "\"

　　'連番
　　'Dim Num As Integer
　　'Num = 1


　　'フォルダの作成を開始
　　For i = 2 To 30 Step 1
　　　　'何も書いていないセルはとばす
　　　　If Cells(i, 1) <> "" Then
　　　　　　'使用不可の文字は消去　\/:*?<>|と改行
　　　　　　For Each notUse In Array("\", "/", ":", "*", "?", "<", ">", "|", vbLf)
　　　　　　　　Cells(i, 1) = Replace(Trim(Cells(i, 1)), notUse, "")
　　　　　　Next notUse

　　　　　　'同じフォルダ名があるかどうかを判断
　　　　　　If Dir(path & Cells(i, 1), vbDirectory) = "" Then
　　　　　　　　'フォルダを作成
　　　　　　　　MkDir path & Trim(Cells(i, 1))
　　　　　　　　'連番をつける場合は上をコメントにして、下を使う
　　　　　　　　'MkDir path & Format(Num, "0#") & "_" & Trim(Cells(i, 1))
　　　　　　　　'Num = Num + 1
　　　　　　End If
　　　　End If
　　Next i

　　Range("A2:A30").Clear

　　MsgBox ("フォルダ作成完了！！")

End Sub

---------------------------------------------------------------------------------------
例

バッチ ～連番でフォルダを作る～

連番でフォルダを作る

1～5までのフォルダを作りたい時はこのようにバッチファイルを作成します。

---------------------------------------------------------------------------------------
FOR /L %%V IN (1,1,5) DO MD パス名\%%V
---------------------------------------------------------------------------------------

「%%v」は変数なので、「%%a」とかでも大丈夫です。
INのかっこ内の意味は（開始の値、ステップ数、終了の値）です。