[[20111214000005]]　『メモ帳内容取得で文字数制限を外す』（カシスソーダ）　ページの最後に飛ぶ

『メモ帳内容取得で文字数制限を外す』（カシスソーダ）

 先日、下記の二つの質問をさせていただき、ご回答をいただき解決しました。ありがとうございました。

[[20111206231619]]　『開いているメモ帳の内容を取得する』（カシスソーダ）
[[20111208235225]]　『開いているメモ帳の内容に別の文字列を追加して元』（カシスソーダ）

 この二つの質問をしたとき、テストデータ(１０文字ばつ２行ほど)だけで試行してました。
 実際のテキストファイルを開いたもので試行すると、メモ帳に入力されている文字列の最初の
 方しか取得しないので何故だろうと思って調べてみたら、

 たとえば、↓の
 >    Dim myText As String * 255
 の部分で「* 255」としている部分が影響していると分かりました。

 Sub test()
    Dim hWnd As Long, hWndEdit As Long
    Dim lngRet As Long
    Dim myText As String * 255

    hWnd = FindWindowEx(0, 0, "Notepad", vbNullString)
    Do While hWnd <> 0
        hWndEdit = FindWindowEx(hWnd, 0, "Edit", "")
        lngRet = SendMessage(hWndEdit, WM_GETTEXT, Len(myText), ByVal myText)
        Debug.Print myText
        hWnd = FindWindowEx(0, hWnd, "Notepad", vbNullString)
    Loop
 End Sub

 そこで、

  Dim myText As String * 32767 '２の１５乗-1

 とすると32767文字(32768文字？)まで取得してくれるようになりました。
 今のところ、これ以上多い文字数はなさそうなので問題ないですが、

  Dim myText As String * 65535 '２の１５乗-1

 とすると、マクロ実行したら

 コンパイルエラー
 固定長文字列の長さが不正です。

 とエラーになってしまいました。

 前もってメモ帳の文字列の長さが分かればいいのかな、とも思いましたが、
 それが出来ないので

 >    Dim myText As String * 255

 と元の質問のリンク先のOKWAVEでの回答でも

 >～と事前に領域確保が必要です。

 と書かれているのだと思いました。

 ここは、

  Dim myText As String * 32767 '２の１５乗-1

 としておくしかないのでしょうか？あるいはもっといい方法があるのでしょうか？

 >APIは難しくて敬遠していたのですが、もっと勉強してみます。

 と書いた矢先の質問で申し訳ありません
 ご教示よろしくお願いいたします。

 固定長だから取得できない。という所までたどり着いていて

 >前もってメモ帳の文字列の長さが分かればいいのかな、とも思いましたが、
 >それが出来ないので

 という事ですから
 まずは、可変長にしてみよう！と思いつきますよね？
 可変長にするには
 Dim 変数 As String
 にしておいて、後で
 変数 = String(長さ, vbNullChar)
 で出来ますね。

 じゃあ、メモ帳の文字列長を取得するにはどうすればよいかな～？と考えてみます。
 SendMessageを使っていますから、そのまま与えるメッセージを変えて文字列長を取得できる
 定数が無いかな～？と探してみるとWM_GETTEXTLENGTH と、いかにも文字列長を取得できそうな
 定数が見つかったりします。
 で、それらを組み合わせてみると・・・

 Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
  (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
   ByVal lpszClass As String, ByVal lpszWindow As String) As Long

 Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
  (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, _
   ByVal lParam As Any) As Long

 Const WM_SETTEXT       As Long = &HC
 Const WM_GETTEXT       As Long = &HD
 Const WM_GETTEXTLENGTH As Long = &HE

 Sub test()
     Dim hWnd As Long, hWndEdit As Long
     Dim lngRet As Long
     Dim lngRc As Long
     Dim myText As String
     Dim txtstr As String
     Dim newtxtstr As String
     Dim tmp As String
     Dim myLen As Long

     txtstr = "hogehoge" & vbCrLf & "hogahoga" & vbCrLf & "hugahuga"

     hWnd = FindWindowEx(0, 0, "Notepad", vbNullString)
     Do While hWnd <> 0
         'Editウインドウハンドル取得
         hWndEdit = FindWindowEx(hWnd, 0, "Edit", "")
         '文字列長を取得
         myLen = SendMessage(hWndEdit, WM_GETTEXTLENGTH, 0&, 0&)
         '文字列長+1分の長さの文字列を確保
         myText = String(myLen + 1, vbNullChar)
         '既存文字列の取得
         lngRet = SendMessage(hWndEdit, WM_GETTEXT, Len(myText), ByVal myText)
         'Nullまでの文字を取得
         tmp = Left$(myText, InStr(1, myText, vbNullChar) - 1)
         '既存文字列と新規文字列の結合
         newtxtstr = tmp & vbCrLf & txtstr & vbNullChar
         '結合文字列の反映
         lngRc = SendMessage(hWndEdit, WM_SETTEXT, 0, newtxtstr)
         hWnd = FindWindowEx(0, hWnd, "Notepad", vbNullString)
     Loop
 End Sub

 こんな感じで出来るかな～？　で、試してみたら私の方では動作確認できました。

 私もメモ帳を操作するAPIを使ったコードを書くのは今回が初めてです。
 カシスソーダさんの質問のおかげで勉強になりました。
 そんな流れで調べてみると、ネットに転がっているヒントだけでも
 なんとかなるかな？と思います。　頑張ってください。
 （ｍｏｍｏ）

 ｍｏｍｏさん、ご回答ありがとうございます。
 ご教示いただいた方法で可変長の文字列の長さを取得できました。
 ありがとうございました。

 他にもネットでウィンドウのタイトルを取得する方法を調べ、開いているメモ帳の
 内容に現在時刻を追記して新規テキストファイルに保存するコードを作ってみました。
 新規テキストファイル名もウィンドウタイトルから生成するようにしました。

 ご教示いただいたコードとネットで調べたものを継ぎ接ぎしたものでもっとすっきり
 したコードに整理できそうな気がしますが、あとはゆっくり調べてみようと思います。
 ありがとうございました。

 Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
 (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
 ByVal lpszClass As String, ByVal lpszWindow As String) As Long

 Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" _
 (ByVal hWnd As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long

 Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" _
 (ByVal hWnd As Long) As Long

 Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
 (ByVal hWnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam As Any) As Long

 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

 Const WM_GETTEXT As Long = &HD
 Const WM_GETTEXTLENGTH As Long = &HE
 Const WM_DESTROY As Long = &H2

 Sub test()
  Dim genzai As String
  Dim hWnd As Long, hWndEdit As Long
  Dim lngRet As Long
  Dim Title As String
  Dim TitleLen As Long
  Dim sts As Boolean
  Dim Ans  As Long
  Dim myText As String
  Dim MyLen As Long
  Dim tmp As String
  Dim newtxtstr As String
  Dim txtmei As String
  Dim fol As String
  Dim cnt As Integer
   '現在時刻
   genzai = Format(Now, "yy年mm月dd日hh時mm分ss秒")　
   'フォルダ名
   fol = CreateObject("WScript.Shell").SpecialFolders("Desktop") _
    & "\" & Format(Now, "yymmdd_hhmmss")
   cnt = 0
   hWnd = FindWindowEx(0, 0, "Notepad", vbNullString)
   If hWnd = 0 Then
      MsgBox "メモ帳が見つかりません。"
      Exit Sub
   End If
   Do While hWnd <> 0
    cnt = cnt + 1
    'フォルダ作成
    If cnt = 1 Then MkDir (fol)
    'タイトル取得
    TitleLen = GetWindowTextLength(hWnd)
    Title = String(TitleLen + 1, 0)
    sts = GetWindowText(hWnd, Title, TitleLen + 1)
    txtmei = Title
    txtmei = Left(txtmei, InStr(txtmei, vbNullChar) - 1)
    If Right(txtmei, 10) = ".txt - メモ帳" Then
       txtmei = Left(txtmei, Len(txtmei) - 10)
    ElseIf txtmei = "無題 - メモ帳" Then
       txtmei = "無題"
    End If
    'タイトルをテキストファイル名に改変
    txtmei = genzai & "_" & Format(cnt, "000") & "(" & txtmei & ")" & ".txt"
    hWndEdit = FindWindowEx(hWnd, 0, "Edit", "")
    MyLen = SendMessage(hWndEdit, WM_GETTEXTLENGTH, 0&, 0&)
    myText = String(MyLen + 1, vbNullChar)
    lngRet = SendMessage(hWndEdit, WM_GETTEXT, Len(myText), ByVal myText)
    tmp = Left$(myText, InStr(1, myText, vbNullChar) - 1)
    newtxtstr = tmp & vbCrLf & genzai
    '新規テキストファイル出力
    Call txtsakusei(newtxtstr, fol & "\" & txtmei)
    Ans = SendMessage(hWnd, WM_DESTROY, 0&, 0&)
    hWnd = FindWindowEx(0, hWnd, "NotePad", vbNullString)
   Loop
 End Sub

 Function txtsakusei(ByVal txtstr As String, txtpath As String)
  Dim fnum As Integer
   fnum = FreeFile
   Open txtpath For Output As fnum
    Print #fnum, txtstr;
   Close fnum
 End Function

 (カシスソーダ)

コメント返信：

[ 一覧(最新更新順) ]

[[20111214000005]] 『メモ帳内容取得で文字数制限を外す』（カシスソーダ） ページの最後に飛ぶ

[[20111214000005]]　『メモ帳内容取得で文字数制限を外す』（カシスソーダ）　ページの最後に飛ぶ