- ベストアンサー
ウエッブ上の画像データの保存
いつもお世話になっています。 仕事で使ったことがない我流ｖｂユーザーです。 例えば、web上の https://sc.pia.jp/captcha/98066a0d3b053e55c307.jpg の画像をｉｅでは「ファイル」-「名前を付けて保存」でファイルに落とすことができます。 それを Public Declare Function InternetReadFile Lib "wininet.dll" _ (ByVal hFile As Long, _ ByVal sBuffer As Byte, _ ByVal lNumBytesToRead As Long, _ ByVal lNumberOfBytesRead As Long) As Long を使って、ファイルに読み込もうとすると、０バイトしか（？）読めなくて、失敗して戻ってきます。 どこに問題があって、改善したら良いのでしょうか。 経験のある方がおられたら、よろしくおねがいします。
- kasukaniwa
- お礼率60% (9/15)
- Visual Basic
- 回答数2
- ありがとう数2
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (1)
関連するQ&A
- WriteFileの引数について
APIを学習中の初心者です。 サンプルコードにあったのですが、test0623.txt のテキストを作成し、「abcde」と書き込むというものです。 Const GENERIC_WRITE = &H40000000 Const GENERIC_READ = &H80000000 Const FILE_ATTRIBUTE_NORMAL = &H80 Const CREATE_ALWAYS = 2 Const OPEN_ALWAYS = 4 Const INVALID_HANDLE_VALUE = -1 Private Declare Function CloseHandle Lib "kernel32" ( _ ByVal hObject As Long) As Long Private Declare Function WriteFile Lib "kernel32" ( _ ByVal hFile As Long, lpBuffer As Any, _ ByVal nNumberOfBytesToWrite As Long, _ lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long Private Declare Function CreateFile Lib "kernel32" _ Alias "CreateFileA" (ByVal lpFileName As String, _ ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _ ByVal lpSecurityAttributes As Long, _ ByVal dwCreationDisposition As Long, _ ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long Sub test1() Dim hFile As Long Dim FileName As String Dim Sampledata() As Byte Dim BytesToWritten As Long Dim SC As Long FileName = "test0623.txt" SC = StrConv("abcde", vbFromUnicode) hFile = CreateFile(FileName, GENERIC_WRITE Or GENERIC_READ, _ 0, 0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0) SC = WriteFile(hFile, Sampledata(0), _ UBound(Sampledata), BytesToWritten, 0) Call CloseHandle(hFile) End Sub とあったのですが質問は以下の通りです。 (1) SC = WriteFile(hFile, Sampledata(0), UBound(Sampledata), BytesWritten, 0) で、な ぜ、lpBuffer(第1引数)にSampledata(0)を指定すれば、ファイルに書き込むべきデータを保持しているバッファへのポインタになるのか？またSampledata(0)のように配列にする理由が不明？ (2) SC = WriteFile(hFile, Sampledata(0), UBound(Sampledata), BytesWritten, 0) で、なぜ、 nNumberOfBytesToWrite(第2引数)に UBound(Sampledata)を指定すれば、ファイルに書き込むべきバイト数になるのか？ここで、0を指定すると、何も書き込まないらしい。 (3) SC = WriteFile(hFile, Sampledata(0), UBound(Sampledata), BytesWritten, 0) で、なぜ、lpNumberOfBytesWritten(第3引数)に何の値も格納していない BytesWritten を記述しているのか？MSDNライブラリには、「関数から制御が返ると、この変数に、実際に書き込まれたバイト数が格納されます。」とあるので、指定しなくてよいのか？ (4) Pathを指定していないが、なぜか、C:\Users\123\Documents に作成される。 以上です。よろしくお願いします
- ベストアンサー
- Windows系OS
- Formを動かせるようにしたい
お世話になります。 OS XP PRO VB6（SP５）で開発しています。 ディスプレイのサイズによりFormを動かせたり固定させたりしたいのですが、 規定値は固定にしたいのでFormプロパティのMoveableはFalseにしてあります。 下記のようにプログラミングしたのですが固定されたままです。 Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function GetSystemMenu Lib "user32" (ByVal _ hwnd As Long _ , ByVal bRevert As Long) As Long Private Declare Function RemoveMenu Lib "user32" ( _ ByVal hMenu As Long, ByVal nPosition As Long, _ ByVal wFlags As Long) As Long Private Declare Function DrawMenuBar Lib "user32" ( _ ByVal hwnd As Long) As Long Private Const MF_BYCOMMAND = &H0 Private Const SC_MOVE = &HF010 Private Sub Form_Load() Dim kk As Long kk = GetSystemMenu(.hwnd, bb) Call RemoveMenu(kk, SC_MOVE, MF_BYCOMMAND) Call DrawMenuBar(.hwnd) End Sub アドバイス頂きたくよろしくお願いします。 以上です。
- ベストアンサー
- Visual Basic
- 「コンパイルエラー End Subが必要です。」
Access2016でファイルを作成しているのですが、下記のVBAを実行しようとすると、「コンパイルエラー End Subが必要です。」とエラーメッセージが返ってきてしまいます。 構文の修正が必要であるとお気づきであれば、その箇所を教えていただけないでしょうか。初歩的な質問で恥ずかしい限りですが、何卒よろしくお願い致します。 Option Compare Database Option Explicit Public Declare PtrSafe Function SetWindowPos Lib "user32" _ (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _ ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, _ ByVal fuFlags As Long) As Long Public Declare PtrSafe Function GetSystemMenu Lib "user32" _ (ByVal hWnd As Long, ByVal fRever As Long) As Long Public Declare PtrSafe Function RemoveMenu Lib "user32" _ (ByVal hMenu As Long, ByVal uItem As Long, ByVal fuFlags As Long) As Long Public Const SWP_NOMOVE = &H2 Public Const SWP_NOSIZE = &H1 Public Const HWND_TOP = &H0 Public Const SC_SIZE = &HF000 Public Const SC_MAXIMIZE = &HF030 Public Const SC_CLOSE = &HF060 Public Const SC_RESTORE = &HF120 Public Const MF_BYCOMMAND = &H0& Public Sub test() Private Sub Form_Open(Cancel As Integer) Dim hWnd As Long hWnd = Application.hWndAccessApp SetWindowPos hWnd, HWND_TOP, 0, 0, 800, 600, SWP_NOMOVE hWnd = GetSystemMenu(hWnd, 0) RemoveMenu hWnd, SC_SIZE, MF_BYCOMMAND End Sub
- 締切済み
- その他(データベース)
- 64ビットエクセルでのAPI宣言/PtrSafe
エクセルのInputboxで、入力された文字列を自動的にアスタリスクで隠すようにする方法を探し http://okwave.jp/qa/q2371878.html の回答No1のコードがまさに最適なコードで、これまで非常に助かっていました。 ところが、64bitのエクセルでは動かないことがわかりました。 表示されたエラーメッセージの言葉から調べて、PtrSafeという言葉を入れなければならないようなのでAPI宣言を以下のようにしてみました。 #If VBA7 And Win64 Then '64ビット版 Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long #Else '32ビット版 Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long #End If ところが、回答No1のコードで Sub Report_Open() を実行すると Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _ Optional YPos, Optional HelpFile, Optional Context) As String のところがハイライトされてエラーになります。 どう直せば良いのでしょうか？ 全文のコードを乗せると字数制限に引っかかりますので、申し訳ありませんが宣言以外の部分は http://okwave.jp/qa/q2371878.html の回答No1のコードを見てくださいますようお願いします。
- ベストアンサー
- Excel（エクセル）
- ExcelVBAでフォームのタイトルバーで右クリックした場合などに閉じるボタンが有効化されないようにするコード
Excelのプログラムで、最小化ボタンを有効にし、閉じるボタンを無効にする質問をしたんですが、うまくいったと思ったのですがフォームが開き、タイトルバーで右クリックした場合などは閉じるボタンが有効化されてしまうのでこれを無効のままにするコードを教えてください。 作ったプログラムは以下の通りです。 標準モジュール Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function DrawMenuBar Lib "user32" _ (ByVal hWnd As Long) As Long Public Declare Function GetSystemMenu Lib "user32.dll" _ (ByVal hWnd As Long, ByVal bRevert As Long) As Long Public Declare Function EnableMenuItem Lib "user32" _ (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long Public Const MF_DISABLED = &H2& Public Const GWL_STYLE = (-16) Public Const WS_MINIMIZEBOX = &H20000 Public Const MF_BYCOMMAND = &H0& Public Const SC_CLOSE = &HF060& Dim hSysMenu As Long UserForm_Initializeプロシージャ Dim fRet As Long Dim hWnd As Long Dim fStyle As Long hWnd = FindWindow("ThunderDFrame", "UserForm1") fStyle = GetWindowLong(hWnd, GWL_STYLE) fStyle = (fStyle Or WS_THICKFRAME Or WS_MINIMIZEBOX) fRet = SetWindowLong(hWnd, GWL_STYLE, fStyle) hSysMenu = GetSystemMenu(hWnd, 0) EnableMenuItem hSysMenu, SC_CLOSE, MF_BYCOMMAND Or MF_DISABLED fRet = DrawMenuBar(hWnd) 回答よろしくお願いします。
- ベストアンサー
- Visual Basic
- VBAでSetTextColorがうまくいかない
EXCELのVBAでユーザーフォームを使ったグラフィック表示のプログラムを 作っているのですが、SetTextColorでテキスト色の設定をしようと してもうまくいきません。何故か設定しようとする色の値が無視されて 「1304008」が設定されてしまいます。(GetTextColorで確認) そしてそれ以降何を設定してもこの状態のままです。 何か考えられることがありますでしょうか。 下にそのプログラムを示します。 ちなみにSetBKColorやAngleArcなど他のグラフィック命令は問題なく 動いていてSetTextColorだけがうまくいってない状態です。 '------------------------------------------------- ' ユーザーフォーム用プログラム '------------------------------------------------- Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpszClass As String, _ ByVal lpszWindow As String) As Long Private Declare Function GetDC Lib "user32" ( _ ByVal hWnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" ( _ ByVal hWnd As Long, _ ByVal hdc As Long) As Long Private Declare Function SetTextColor Lib "gdi32" _ (ByVal hdc As Long, crColor As Long) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" _ (ByVal hdc&, ByVal x&, _ ByVal y&, ByVal lpString$, ByVal nCount&) As Long Dim hWnd As Long Dim hdc As Long Public Sub UserForm_Activate() DoEvents hWnd = FindWindowEx(GetActiveWindow, 0, "F3 Server 60000000", "") hdc = GetDC(hWnd) ret = SetTextColor(hdc, RGB(255, 0, 0)) ret = TextOut(hdc, 0, 0, "abc", 3) Call ReleaseDC(hWnd, hdc) End Sub '-------------------------------------------------
- ベストアンサー
- Visual Basic
- VBAでのカーソル移動とマウスクリック
業務上の単純作業の自動化のため、VBAから他のアプリケーションを操作することが目的です。 以前、ブラウザ上での作業の時に使用した、下記2つのAPIでは今回はマウスカーソルが指定した座標に動いてくれません、、、 Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal Y As Long) As Long Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) この2つのAPI以外で、カーソル移動とマウスクリックを実現する方法は何かありますでしょうか？ 色々な方法を教えていただけるとVBAの勉強にもなり幸いです。 ' // 標準モジュール Option Explicit Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal Y As Long) As Long Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long) Private Type POINTAPI x As Long y As Long End Type Private Sub クリックテスト() Call SetCursorPos(216, 421) Sleep 400 Call mouse_event(&H2, 0, 0, 0, 0) Call mouse_event(&H4, 0, 0, 0, 0) End Sub
- 締切済み
- オフィス系ソフト
- EXCELVBA フォルダ検索API
エクセルからVBAでフォルダを選択させるコマンドを、APIを使ってフォルダ検索ダイアログボックスを出すまでは見よう見真似でできるのですが、このとき「あたらしいフォルダ」のボタンは必要ないので出したくないのですが、どこかに定数を指定すればよろしいかご存知でしたら教えてください。 (使用OS： Windows2000,Excel：2003) ちなみにコピペした宣言部分は以下のものです。 *************** Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _ (ByVal pidl As Long, ByVal pszPath As String) As Long Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _ (lpBrowseInfo As BROWSEINFO) As Long Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long) Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, lParam As Any) As Long Public Const WM_USER = &H400 Public Const BFFM_SETSELECTIONA = (WM_USER + 102) Public Const BFFM_INITIALIZED = 1 ********************
- 締切済み
- オフィス系ソフト
- ネットのファイルをダウンロードする方法を教えてください。
web上のファイルをダウンロードするには Public Declare Function URLDownloadToFile Lib "urlmon" _ Alias "URLDownloadToFileA" (ByVal pCaller As Long, _ ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long と宣言してURLDownloadToFileを使えばできることがわかりましたが、うまく行かないケースがあります。おそらく通常の右クリックでダウンロードするものではなく、URLを左クリックして行うものだからじゃないかと思います。いいアイディアはないでしょうか？？
- 締切済み
- Visual Basic
- ExcelVBAでのkernel32(64bit)
今までExcel2000のVBAから、以下のようなコードを使ってC++で作ったコマンドプロンプトで動くプログラムを動かすプログラムを作っていましたが、これを64bitのWindows7上で動いているExcel2010で使おうとしたらメッセージが出ました。いろいろ調べてみたところ、たぶんDeclareにPtrSafeを付ければ良いようなのですが、その際、他のコードはそのままで良いのでしょうか。特に、コード中のLongはそのままで良いのか気になるのですが...。ちなみに、下記コードの条件コンパイルはネットで調べて見よう見まねで付けたもので、Excel2000のときには付けていないものでした。ご存じの方がいらっしゃいましたらご教授ください。 '------------------------------------------------------------------------------ ' Win32 API関数・定数の宣言 '------------------------------------------------------------------------------ #If VBA7 And Win64 Then '64bit Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _ ByVal dwMilliseconds As Long) As Long Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long #Else '32bit Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _ ByVal dwMilliseconds As Long) As Long Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _ ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long #End If Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF Private Const INFINITE As Long = &HFFFF '------------------------------------------------------------------------------ ' Run '------------------------------------------------------------------------------ Public Sub Run(ByVal project_name As String) Dim program As String Dim task_id As Long Dim h_proc As Variant program = mdlFunc.ProgramPath() & mdlFunc.ProgramOption(project_name) 'プログラム名 task_id = Shell(program, vbHide) h_proc = OpenProcess(PROCESS_ALL_ACCESS, False, task_id) If OpenProcess(PROCESS_ALL_ACCESS, False, task_id) <> vbNull Then Call WaitForSingleObject(h_proc, INFINITE) CloseHandle h_proc End If End Sub
- ベストアンサー
- Visual Basic
補足
Dim WebClient As New System.Net.WebClient WebClient.DownloadFile(JPG_URL, FileName) 上記２行で達成できることがわかりました ありがとうございます