VBSの質問です

以前コチラで行った質問の続きです
以下のプログラムを取得フォルダの2つ上のフォルダからリンクを取得してくるようにしていただきたいのですがどうすればいいでしょうか?よろしくお願いします。
例 a>a>a なら <img src="a/a/a/" になるようにです

回答の条件
  • 1人5回まで
  • 13歳以上
  • 登録:2014/01/26 18:24:44
  • 終了:2014/02/02 18:25:03
id:takanii
    Dim file       ' 対象ファイル
    Dim file2      ' 書き込み先ファイル
    Dim re         ' 正規表現オブジェクト
    Dim strOldText ' 置換前テキスト
    Dim strNewText ' 置換後テキスト
    Dim strFind    ' 検索文字列
    Dim strReplace ' 置換文字列
    Set file = fso.OpenTextFile( strInputFileName )
    strOldText = file.ReadAll
Set re = New RegExp
re.Multiline = True
re.Global = True
' 置換1
strFind = "<img src = """
strReplace = "<img src=""" & strTargetName & "/"
re.Pattern = strFind
strNewText = re.Replace(strOldText, strReplace)
' 置換2
strFind = "<td align=""center"" valign=""top"">"
strReplace = "<td>" & strTargetName & "</td><td>"
re.Pattern = strFind
strNewText = re.Replace(strNewText, strReplace)

    file.Close
    Set file2 = fso.CreateTextFile( strOutputFileName )
    file2.WriteLine (strNewText)
    file2.Close
End Sub

回答(0件)

回答はまだありません

  • id:taknt
    一部分だけでなくエラーが出ずに動くものを 質問にあげてもらったほうがよいと思いますよ。
  • id:takanii
    コメントありがとうございます
    こちらになっております

    Dim objFileSys
    Dim strScriptPath
    Dim strDeleteFrom
    Set objFileSys = CreateObject("Scripting.FileSystemObject")
    strScriptPath = Replace(WScript.ScriptFullName,WScript.ScriptName,"")
    strDeleteFrom = objFileSys.BuildPath(strScriptPath, ".\hoge\*")
    objFileSys.DeleteFile strDeleteFrom, True
    Set objFileSys = Nothing

    'ファイルネームリネーム
    Call Main()
    Sub Main()
    Dim fso ' ファイルシステムオブジェクト
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim folder
    Set folder = fso.GetFolder(".")
    Dim strTargetName ' 対象フォルダ名
    Dim strInputFileName ' 入力ファイル名
    Dim strOutputFileName ' 出力ファイル名
    Dim subFolder
    For Each subFolder In folder.SubFolders
    strTargetName = subFolder.Name
    ' フォルダ名が数字の場合、処理対象とする
    If IsNumeric( strTargetName ) Then
    strInputFileName = subFolder & "\test.html"
    strOutputFileName = folder.Path & "\hoge\" & strTargetName & ".html"
    Call ChangePathName( fso, strTargetName, strInputFileName, strOutputFileName )
    End If
    Next
    End Sub
    Sub ChangePathName( fso, strTargetName, strInputFileName, strOutputFileName )

    Dim file ' 対象ファイル
    Dim file2 ' 書き込み先ファイル
    Dim re ' 正規表現オブジェクト
    Dim strOldText ' 置換前テキスト
    Dim strNewText ' 置換後テキスト
    Dim strFind ' 検索文字列
    Dim strReplace ' 置換文字列
    Set file = fso.OpenTextFile( strInputFileName )
    strOldText = file.ReadAll
    Set re = New RegExp
    re.Multiline = True
    re.Global = True
    ' 置換1
    strFind = "<img src = """
    strReplace = "<img src=""" & strTargetName & "/"
    re.Pattern = strFind
    strNewText = re.Replace(strOldText, strReplace)
    ' 置換2
    strFind = "<td align=""center"" valign=""top"">"
    strReplace = "<td>" & strTargetName & "</td><td>"
    re.Pattern = strFind
    strNewText = re.Replace(strNewText, strReplace)

    file.Close
    Set file2 = fso.CreateTextFile( strOutputFileName )
    file2.WriteLine (strNewText)
    file2.Close
    End Sub

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません