複数のURL(webページ)から特定文字が含まれているURLのみを調べる方法について教えてください。
海外サイトの調査候補URLを複数用意し、そのURLのページソースに「news」という特定文字列が含まれているURLを抽出する方法として、エクセルのマクロで以下を試してみました。
----------
Sub KeyWord_Search()
Dim objHTTP As Object
Dim i As Long
Const strKW As String = "news"
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
With objHTTP
For i = 1 To Range("A1").End(xlDown).Row
.Open "GET", Cells(i, 1).Value, False
.Send
If .Status = 200 Then If InStr(1, .ResponseText, strKW, 1) > 0 Then Cells(i, 2).Value = "＊"
Next
End With
Set objHTTP = Nothing
End Sub
----------
きちんと抽出されるURLもあれば、以下のようなエラーが発生するURLもあります。
----------
実行時エラー'-2147023783(80070459)':
Unicode 文字のマッピングがターゲットのマルチバイト コード ページにありません。
----------
恐らく文字コードの問題だと想像していますが、マクロについて全く知識がないため解決方法がわかりません。なお、上記のマクロはGoogle検索で調べたものをそのままコピー貼り付けしたものです。
また、存在しないURLと「処理がタイムアウト」するURLは処理から除外したいと考えいます。
よろしくお願いします。
複数のURL(webページ)から特定文字が含まれているURLのみを調べる方法について教えてください。
海外サイトの調査候補URLを複数用意し、そのURLのページソースに「news」という特定文字列が含まれているURLを抽出する方法として、エクセルのマクロで以下を試してみました。
----------
Sub KeyWord_Search()
Dim objHTTP As Object
Dim i As Long
Const strKW As String = "news"
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
With objHTTP
For i = 1 To Range("A1").End(xlDown).Row
.Open "GET", Cells(i, 1).Value, False
.Send
If .Status = 200 Then If InStr(1, .ResponseText, strKW, 1) > 0 Then Cells(i, 2).Value = "＊"
Next
End With
Set objHTTP = Nothing
End Sub
----------
きちんと抽出されるURLもあれば、以下のようなエラーが発生するURLもあります。
----------
実行時エラー'-2147023783(80070459)':
Unicode 文字のマッピングがターゲットのマルチバイト コード ページにありません。
----------
恐らく文字コードの問題だと想像していますが、マクロについて全く知識がないため解決方法がわかりません。なお、上記のマクロはGoogle検索で調べたものをそのままコピー貼り付けしたものです。
また、存在しないURLと「処理がタイムアウト」するURLは処理から除外したいと考えいます。
よろしくお願いします。
複数のURL(webページ)から特定文字が含まれているURLのみを調べる方法について教えてください。
海外サイトの調査候補URLを複数用意し、そのURLのページソースに「news」という特定文字列が含まれているURLを抽出する方法として、エクセルのマクロで以下を試してみました。
----------
Sub KeyWord_Search()
Dim objHTTP As Object
Dim i As Long
Const strKW As String = "news"
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
With objHTTP
For i = 1 To Range("A1").End(xlDown).Row
.Open "GET", Cells(i, 1).Value, False
.Send
If .Status = 200 Then If InStr(1, .ResponseText, strKW, 1) > 0 Then Cells(i, 2).Value = "＊"
Next
End With
Set objHTTP = Nothing
End Sub
----------
きちんと抽出されるURLもあれば、以下のようなエラーが発生するURLもあります。
----------
実行時エラー'-2147023783(80070459)':
Unicode 文字のマッピングがターゲットのマルチバイト コード ページにありません。
----------
恐らく文字コードの問題だと想像していますが、マクロについて全く知識がないため解決方法がわかりません。なお、上記のマクロはGoogle検索で調べたものをそのままコピー貼り付けしたものです。
また、存在しないURLと「処理がタイムアウト」するURLは処理から除外したいと考えいます。
よろしくお願いします。
Sub Macro1()
Range("a:c,e:g").Select
End Sub
を数値にしたいのですが、
Sub Macro2()
Range(Columns(1), Columns(3) & ":" & Columns(5), Columns(7)).Select
End Sub
だと、rangeでコンパイルエラーになります。
http://okwave.jp/qa/q7329478.html
を見たのですが、
どうすればいいのかわからないので教えてください。
vbaでクリップボードにデータを送る（コピーする）には？
エクセルです。
Sub Macro()
Selection.Copy
End Sub
で、クリップボードにデータを送ってることになりますよね？
「どこかのセルをコピーする」ではなく、例えば「abc」という文字をコピーさせて、
いつでも貼り付けられる状態にしたいのですが、vbaでそういうことは可能ですか？
Sub Macro()
"abc"をクリップボードに送る
End Sub
的な事がしたいです。
下記ソースについて、コピー元ファイルがDやCドライブにあるものは
指定したコピー先にファイルを貼り付けることができるのですが、
コピー元がサーバー上である場合、指定したコピー先にファイルが
貼りつきません。何か特別な処理等が必要でしょか？
ご教授ください。
Dim fs
Dim msg
Dim f
Dim copyFrom
copyFrom = Array("D:\VBS\", "D:\VBS\AB\")
Dim Ar
Const copyTo = "D:\VBS\コピー先\"
Do
'日付入力のインプットボックスを出力
hizuke = InputBox("日付を入力してください。" & vbCr & vbCr & "例）2000-01-01")
'インプットボックスの入力値が空白である
If hizuke = "" Then
'日付入力を促すメッセージ出力
MsgBox "日付を入力してください。"
Exit Do
End If
'インプットボックスの入力値が10文字である
If Len(hizuke) = 10 Then
'エラーが発生しても次の処理をすすめる
On Error Resume Next
'指定した日付の確認ダイアログを表示
msg = MsgBox(hizuke & "でよろしいですか？", vbYesNoCancel)
'日付の確認ダイアログでYesを選択
If msg = vbYes Then
For Each Ar In copyFrom
MsgBox(Ar)
'ファイルオブジェクトを作成
Set fs = CreateObject("Scripting.FileSystemObject")
'コピー元フォルダに存在するファイルを読み込む
For Each f In fs.GetFolder(Ar).Files
'指定した日付を含むファイル名を検索
If InStr(f.Name, hizuke) > 0 Then
MsgBox(copyFrom & "フォルダ")
MsgBox(f.Name & "名前")
fs.CopyFile Ar & f.Name, copyTo
End If
Next
Next
Exit Do
Else
Exit Do
End If
Else
MsgBox("入力値が不正です。")
End If
Loop
こんばんは。宜しくお願いします。
◇行いたいこと
複数のフォルダ(例："D:\AB" "D:\CD" "D:\EF")に格納されているファイルの中から指定した
日付を含んだファイルをコピーし、あるフォルダに張り付けたい。
(指定する日付を含んだファイルがすべてのフォルダに存在するとは限らない)
◇現時点でのソース
※エラー処理の未実装部分については無視していただいてけっこうです。
Dim fs
Dim msg
Dim f
Const copyFrom = "D:\AB"
Const copyTo = "D:\VBS\コピー先\"
Do
'日付入力のインプットボックスを出力
hizuke = InputBox("日付を入力してください。" & vbCr & vbCr & "例）2000-01-01")
'インプットボックスの入力値が空白である
If hizuke = "" Then
'日付入力を促すメッセージ出力
MsgBox "日付を入力してください。"
Exit Do
End If
'インプットボックスの入力値が10文字である
If Len(hizuke) = 10 Then
'エラーが発生しても次の処理をすすめる
On Error Resume Next
'指定した日付の確認ダイアログを表示
msg = MsgBox(hizuke & "でよろしいですか？", vbYesNoCancel)
'日付の確認ダイアログでYesを選択
If msg = vbYes Then
'ファイルオブジェクトを作成
Set fs = CreateObject("Scripting.FileSystemObject")
'コピー元フォルダに存在するファイルを読み込む
For Each f In fs.GetFolder(copyFrom).Files
'指定した日付を含むファイル名を検索
If InStr(f.Name, hizuke) > 0 Then
'未実装 ファイルの上書き処理
fs.CopyFile 'コピー元 コピー先
Exit Do
'未実装 Else Ifの処理
End If
Next
'未実装 Else Ifの処理
End If
'未実装 Else Ifの処理
End If
Loop
以上です。ご教授宜しくお願いします。
