[PR]
2025年07月02日
×
[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。
クリップボードの内容をテキストファイルに保存するVBScript②
2020年04月27日
前回、クリップボードの文字列を取得して、
日時＋ファイル名指定でメモ帳に保存するVBscriptを作った。
動作確認したところ、環境依存文字が含まれるとうまくいかない。
WEBページの文字列って環境依存系多いのよね。
ブラウザ履歴を取得するマクロを作ったときも苦労したな。。。
で、調べたらいいページ発見。
https://blog.systemjp.net/entry/2013/04/10/191821
CreateTextFileの指定を変えるとUnicodeになるようだ。
修正前：fso.CreateTextFile(fName, true)
修正後：fso.CreateTextFile(fName, true,true)
CreateTextFileメソッドについては、ここがわかりやすい。
https://vbabeginner.net/filesystemobject%E3%81%AEcreatetextfile%E3%83%A1%E3%82%BD%E3%83%83%E3%83%89/
ただし、VBscript自体の文字コードもUnicodeで保存する必要あり！
その他、InputBoxを表示中にコピー操作もあるので、処理順を変更。
以下、ソース。
'ファイル名を生成
dim iText
iText = inputbox("ファイル名を指定")
dim ClipText
ClipText=GetClipboardText()
dim date,fName
date=Replace(now, "/", "")
date=Replace( date , ":" , "" )
date=Replace( date , " " , "_" )
date=left(date , 13)
if iText ="" then
fName ="ClipText_" & date & ".txt"
else
fName ="ClipText_" & date & "(" & iText & ").txt"
end if
'テキストファイルを作って書き込み https://win.just4fun.biz/
dim fso,tso
Set fso = CreateObject("Scripting.FileSystemObject")
Set tso = fso.CreateTextFile(fName, true,true) ' unicode
tso.Write(ClipText)
tso.Close
'クリップボードを取得 'http://osanai.org/47/
Function GetClipboardText()
Dim objHTML
Set objHTML = CreateObject("htmlfile")
GetClipboardText = Trim(objHTML.ParentWindow.ClipboardData.GetData("text"))
End Function
PR
日付のフォルダを作るVBscript
2020年04月27日
なんかの作業をする場合、日付のフォルダを作ることが多い。
日付だけの場合もあれば、アンダーバーで区切って内容を入れることも。
前回、日付のファイルを作ったので、同様にやってみた。
まずは、日付のフォルダを作るところをググる。
https://dev.w.ezic.info/1926.html
こんなもんか。
例によって、InputBoxを使って文字を取得して、
その内容によって分岐。
テキストファイルは上書きでOKだけど、
フォルダはそうもいかないので存在チェック。
https://multiplechoice.hatenablog.com/entry/2017/12/10/195302
ファイルとフォルダ違うけど、fileをFolderに修正して動いた。
処理の流れは、こんな感じ。
まず、文字を入力。
なしなら日付のフォルダ、あれば日付_入力した文字のフォルダ。
個人的な都合で、「)」で始まる文字を入れた場合は、
日付を（）で挟むフォルダ。
以下、ソース。
日付だけの場合もあれば、アンダーバーで区切って内容を入れることも。
前回、日付のファイルを作ったので、同様にやってみた。
まずは、日付のフォルダを作るところをググる。
https://dev.w.ezic.info/1926.html
こんなもんか。
例によって、InputBoxを使って文字を取得して、
その内容によって分岐。
テキストファイルは上書きでOKだけど、
フォルダはそうもいかないので存在チェック。
https://multiplechoice.hatenablog.com/entry/2017/12/10/195302
ファイルとフォルダ違うけど、fileをFolderに修正して動いた。
処理の流れは、こんな感じ。
まず、文字を入力。
なしなら日付のフォルダ、あれば日付_入力した文字のフォルダ。
個人的な都合で、「)」で始まる文字を入れた場合は、
日付を（）で挟むフォルダ。
以下、ソース。
'文字列を取得
dim iText
iText = inputbox("作成するフォルダの内容は？")
'フォルダ名
dim date,DirName
date=Replace(now, "/", "")
date=left(date , 8)
if iText ="" then
DirName =date
elseif left(iText,1)=")" then
DirName = "(" & date & ")_" & mid(iText ,2,len(iText)-1)
else
DirName = date & "_" & iText
end if
' ファイルストリーム・オブジェクト生成
Set objFS = CreateObject("Scripting.FileSystemObject")
If objFS.FolderExists(DirName) Then
msgbox "すでにフォルダが存在します"
else
' フォルダを生成する
str_path = objFS.CreateFolder(DirName)
end if
クリップボードの内容をテキストファイルに保存するVBScript①
2020年04月26日
LiveMailを使ってて、印刷や保存をするとき、
印刷プレビューを表示して、印刷ボタンを押す。
だけど、Edgeの印刷はUIがいけてないし、LiveMailの印刷プレビューとかモサモサ。
PDF保存に至っては、PDFプリンタ選択してファイル名指定ってもうイヤ。
じゃあもうテキストファイルでいいじゃん！という話。
テキストファイル扱うんだったら,VBscriptでできるんじゃね？と思いつくってみた。
いずれもググってすぐ欲しいソースが出てきた。めっちゃ簡単やん。
処理の流れ
まずは、クリップボードのテキストを取得。
http://osanai.org/47/
次に、テキストの内容をファイルに出力。
https://win.just4fun.biz/?WSH/ファイルを新規に作成しテキストを書き込むサンプルコード#h38cd307
これで十分そうだけど、保存するファイル名変えたいよね。
now関数で現在時刻を文字列で取れるので、Replaceで置換してファイル名に放り込み。
ファイル名を指定するだけで、スクリプトファイルと同じディレクトリに
クリップボードの内容が日付入りのファイル名で保存される。
いい感じだ！！！
以下、ソース。
の前に、やっぱりファイル名とか自由に変えられたほうがいいよね。
InputBoxで文字を入れたら、それがファイル名に使われる仕様も入れてみた。
今度こそソース。
'ファイル名を生成
印刷プレビューを表示して、印刷ボタンを押す。
だけど、Edgeの印刷はUIがいけてないし、LiveMailの印刷プレビューとかモサモサ。
PDF保存に至っては、PDFプリンタ選択してファイル名指定ってもうイヤ。
じゃあもうテキストファイルでいいじゃん！という話。
テキストファイル扱うんだったら,VBscriptでできるんじゃね？と思いつくってみた。
いずれもググってすぐ欲しいソースが出てきた。めっちゃ簡単やん。
処理の流れ
まずは、クリップボードのテキストを取得。
http://osanai.org/47/
次に、テキストの内容をファイルに出力。
https://win.just4fun.biz/?WSH/ファイルを新規に作成しテキストを書き込むサンプルコード#h38cd307
これで十分そうだけど、保存するファイル名変えたいよね。
now関数で現在時刻を文字列で取れるので、Replaceで置換してファイル名に放り込み。
ファイル名を指定するだけで、スクリプトファイルと同じディレクトリに
クリップボードの内容が日付入りのファイル名で保存される。
いい感じだ！！！
以下、ソース。
の前に、やっぱりファイル名とか自由に変えられたほうがいいよね。
InputBoxで文字を入れたら、それがファイル名に使われる仕様も入れてみた。
今度こそソース。
dim ClipText
ClipText=GetClipboardText()
'テキスト取得
dim iText
iText = inputbox("ファイル名を指定")
'ファイル名を生成
dim date,fName
date=Replace(now, "/", "")
date=Replace( date , ":" , "" )
date=Replace( date , " " , "_" )
date=left(date , 13)
if iText ="" then
fName ="ClipText_" & date & ".txt"
else
fName ="ClipText_" & date & "(" & iText & ").txt"
end if
'テキストファイルを作って書き込み https://win.just4fun.biz/
dim fso,tso
Set fso = CreateObject("Scripting.FileSystemObject")
Set tso = fso.CreateTextFile(fName, true)
tso.Write(ClipText)
tso.Close
'クリップボードを取得 'http://osanai.org/47/
Function GetClipboardText()
Dim objHTML
Set objHTML = CreateObject("htmlfile")
GetClipboardText = Trim(objHTML.ParentWindow.ClipboardData.GetData("text"))
End Function
どうやら環境依存文字があるとうまくいかない。てなわけで②に続く。
どうやら環境依存文字があるとうまくいかない。てなわけで②に続く。
splitしてタイトルをつけるマクロ①
2020年04月25日
よく出てくるクソデータとして、
１セルの中に長いメッセージがあって、「○○＝ｘｘｘ」って
毎行にタイトル項目を記載するデータ。
見づらさの極み。
今回は、上記のタイトル項目が全行に記載されているテキストを整理する。
整理対象の列のデータは以下の形式
タイトル
メッセージ。（○○＝XXX)（○×＝YYY)（×○＝ZZZ)
メッセージ。（○○＝XXX)（○×＝BBB)（×○＝XYZ)
メッセージ。（○○＝XXX)（○×＝AAA)（×○＝XYX)
やりたいことは、メッセージと各タイトル、各値にsplitすること。
まず、「)」は不要なので置換。replace関数で消す。
次に「(」でsplit
２列目から最終列については、タイトルと値に分割
これは、「=」でsplit
出力先は、データベースの右側にアペンドする形。
タイトル行の最終列に対してoffsetで指定。
いきなりぶっこむマクロなので、確認メッセージを追加。
if msg( ,vbOKCancel) then の形にすると変数を定義しなくていける。
一応、大量データも想定して、配列に格納してからドカンと出力。
配列を出力するモジュールがあれば、結構簡単。
以下、ソース。
4/26 追記
動かしてみたら、整理対象データの項目数がまちまちで、
タイトル数が行によって違うことが判明。
残念。
不一致の場合は、全体タイトル行を舐めて、一致した列に出力する必要があるなぁ。
お試しの１行処理も、行を選択できるようにしなきゃか。
１セルの中に長いメッセージがあって、「○○＝ｘｘｘ」って
毎行にタイトル項目を記載するデータ。
見づらさの極み。
今回は、上記のタイトル項目が全行に記載されているテキストを整理する。
整理対象の列のデータは以下の形式
タイトル
メッセージ。（○○＝XXX)（○×＝YYY)（×○＝ZZZ)
メッセージ。（○○＝XXX)（○×＝BBB)（×○＝XYZ)
メッセージ。（○○＝XXX)（○×＝AAA)（×○＝XYX)
やりたいことは、メッセージと各タイトル、各値にsplitすること。
まず、「)」は不要なので置換。replace関数で消す。
次に「(」でsplit
２列目から最終列については、タイトルと値に分割
これは、「=」でsplit
出力先は、データベースの右側にアペンドする形。
タイトル行の最終列に対してoffsetで指定。
いきなりぶっこむマクロなので、確認メッセージを追加。
if msg( ,vbOKCancel) then の形にすると変数を定義しなくていける。
一応、大量データも想定して、配列に格納してからドカンと出力。
配列を出力するモジュールがあれば、結構簡単。
以下、ソース。
Option Explicit
Sub RA_Split()
Dim Col As Long: Col = Selection.Column
Dim Egyo As Long: Egyo = Cells(Rows.Count, Col).End(xlUp).Row
Dim Tgyo As Long: Tgyo = Col2Tgyo(Col)
Dim i As Long '配列格納用変数
Dim iMax As Long: iMax = Egyo - Tgyo
If Egyo = 1 Then
MsgBox "データがありません"
Exit Sub
End If
Dim Tcell As Range: Set Tcell = Cells(Tgyo, Columns.Count).End(xlToLeft).Offset(0, 1)
If MsgBox("「" & Cells(Tgyo, Col).Value & "」列の内容を「" & Tcell.Address & "」セルに出力します", vbOKCancel) = vbCancel Then
Exit Sub
End If
Dim tictoc As Double
tictoc = Timer
Dim Gyo As Long: Gyo = Tgyo + 1 '行を定義して、２行目を実行してサイズ検証
Dim buf, mbuf, k As Long '「(」と「=」でsplit用のバッファと配列ループ用変数
buf = Split(Replace(Cells(Gyo, Col).Value, ")", ""), "(") ' 「)」を消して、「(」でsplit
Dim Arr(), tArr() '２配列
ReDim Arr(iMax, UBound(buf)) '2次元出力配列
ReDim tArr(iMax, UBound(buf)) '2次元タイトル配列（エラーチェック用）
Arr(0, 0) = "Text" 'メッセージテキストのタイトルは決め打ち
For k = 1 To UBound(buf)
mbuf = Split(buf(k), "=")
Arr(0, k) = mbuf(0) '先にタイトルを確定させる
Next k
For i = 0 To iMax 'タイトル行から最終行まで
Gyo = i + Tgyo
buf = Split(Replace(Cells(Gyo, Col).Value, ")", ""), "(") ' 「)」を消して、「(」でsplit
For k = 1 To UBound(buf)
mbuf = Split(buf(k), "=")
tArr(i, k) = mbuf(0)
If UBound(mbuf) = 1 Then
Arr(i, k) = mbuf(1) '=が入ってないかも
End If
If tArr(i, k) <> Arr(0, k) Then
Debug.Print "タイトル行エラー i=" & i & "k=" & k
End If
Arr(i, 0) = buf(0)
Next k
Next i
''出力
Call 配列貼り付け_2d(Tcell, Arr)
Debug.Print "[" & Now & "] "; Format(Timer - tictoc, "0.00秒")
End Sub
Sub 配列貼り付け_2d(Target As Range, oArr, Optional ColCnt As Long = 0) '配列貼り付け便利モジュール
Dim iRowMax: iRowMax = UBound(oArr, 1) - LBound(oArr, 1) + 1 '// １次元目の要素数を取得 '// 二次元配列の最大行数
Dim iColMax: iColMax = UBound(oArr, 2) - LBound(oArr, 2) + 1 '// ２次元目の要素数を取得'// 二次元配列の最大列数
'// Rangeオブジェクトで開始セルから貼り付けるセル範囲を拡張する場合
If ColCnt > 0 And ColCnt <= iColMax Then
Target.Resize(iRowMax, ColCnt).Value = oArr
Else
Target.Resize(iRowMax, iColMax).Value = oArr
End If
End Sub
Function Col2Tgyo(Col As Long) As Long
If Cells(1, Col) <> "" Then
Col2Tgyo = 1
Else
Col2Tgyo = Cells(1, Col).End(xlDown).Row
End If
End Function
4/26 追記
動かしてみたら、整理対象データの項目数がまちまちで、
タイトル数が行によって違うことが判明。
残念。
不一致の場合は、全体タイトル行を舐めて、一致した列に出力する必要があるなぁ。
お試しの１行処理も、行を選択できるようにしなきゃか。
楽天モバイルをはじめてみた
2020年04月23日
友人に勧められて、楽天モバイルのSIMを契約しました。
持っている機器
iPhone 11
iPhone 6s
GL06P
楽天モバイルのSIMカードは、iPhone Xs以上で使えるとか。
家で遊んでいるモバイルルータGL06Pでも
楽天の電波を受けれるようで契約に。
楽天モバイル
https://network.mobile.rakuten.co.jp/
楽天エリア内だと、使い放題。
エリア外だとAUの電波を使って通信。月５Gまで高速。←4/23からUP
４月１４日に申し込んで、４月１７日にSIMカードが届いた。
早速GL06Pで試してみる。
・・・。電波入らない・・・。
そこでようやくサービスエリアを調べてみると楽天エリア外。
どうやらGL06Pでは、AUのバンドは対応していない模様。
都内に持ち込んで試してようやく圏内に！
通信速度は、だいたい１Mとか。
速度は出ても安定感がなくて、LINEの通話が途切れまくって使い物にならなかった。
ちなみにiPhone11にSIMを挿したところ、無事動きました。
データローミングをONにしないと動作しないので要注意！！
iPhone11の場合は、ハードウェアの性能がアップしているので、
使用感に問題はない模様（自分でも使ってみりゃよかった）
コロナの影響による在宅勤務への備えで急ぎ契約したけど、
そもそも、eSIMを使うことが目的だったので、思い切ってSIM変更。
４月２３日 ０１：００に変更の申し込み実施。
が、間違えて新しいSIMカード申し込んでるし。
そもそも初回の申し込みでeSIMは選択できない認識だったけど、
申し込み画面を見ていると最初からeSIM選択できたのに気づかなかったのか。
このままじゃ月額費用が発生するので、
現契約もeSIM変更手続きをして、申し込みを電話でキャンセルすることにした。
それがいけなかった。
いろいろ調べてみたところ、携帯電話は８日以内であれば書面交付することで
契約を解除することができるけれども、事務手数料は戻ってこないもよう。
今日は１日サポートセンターに電話したけど全く繋がらず。
３０分以上通話状態で普通に通話料取られてるし、ばかばかしくなってきた。
授業料6000円・・・高くついたわ。
eSIMが届いたらまた更新します。
まとめ
4月26日追記
楽天コールセンターの0800で始まる番号は、フリーダイヤルでした。
なので通話料無料。
朝９：００になった瞬間電話をかけて、すばやく１５とプッシュ。
なんかしゃべったのでもう一回１５をプッシュして、無事に電話繋がりました。
キャンセル手続き無事完了。通話時間５分。
受付は20時までのはずなのに、この間は18時過ぎに受付終了になってて、
夕方だと２時間待ちみたい。かけるなら朝9時だね。
持っている機器
iPhone 11
iPhone 6s
GL06P
楽天モバイルのSIMカードは、iPhone Xs以上で使えるとか。
家で遊んでいるモバイルルータGL06Pでも
楽天の電波を受けれるようで契約に。
楽天モバイル
https://network.mobile.rakuten.co.jp/
楽天エリア内だと、使い放題。
エリア外だとAUの電波を使って通信。月５Gまで高速。←4/23からUP
４月１４日に申し込んで、４月１７日にSIMカードが届いた。
早速GL06Pで試してみる。
・・・。電波入らない・・・。
そこでようやくサービスエリアを調べてみると楽天エリア外。
どうやらGL06Pでは、AUのバンドは対応していない模様。
都内に持ち込んで試してようやく圏内に！
通信速度は、だいたい１Mとか。
速度は出ても安定感がなくて、LINEの通話が途切れまくって使い物にならなかった。
ちなみにiPhone11にSIMを挿したところ、無事動きました。
データローミングをONにしないと動作しないので要注意！！
iPhone11の場合は、ハードウェアの性能がアップしているので、
使用感に問題はない模様（自分でも使ってみりゃよかった）
コロナの影響による在宅勤務への備えで急ぎ契約したけど、
そもそも、eSIMを使うことが目的だったので、思い切ってSIM変更。
４月２３日 ０１：００に変更の申し込み実施。
が、間違えて新しいSIMカード申し込んでるし。
そもそも初回の申し込みでeSIMは選択できない認識だったけど、
申し込み画面を見ていると最初からeSIM選択できたのに気づかなかったのか。
このままじゃ月額費用が発生するので、
現契約もeSIM変更手続きをして、申し込みを電話でキャンセルすることにした。
それがいけなかった。
いろいろ調べてみたところ、携帯電話は８日以内であれば書面交付することで
契約を解除することができるけれども、事務手数料は戻ってこないもよう。
今日は１日サポートセンターに電話したけど全く繋がらず。
３０分以上通話状態で普通に通話料取られてるし、ばかばかしくなってきた。
授業料6000円・・・高くついたわ。
eSIMが届いたらまた更新します。
まとめ
- 契約後のキャンセルはできないので慎重に！！！
- 電話サポートは、通話料かかるのに全く繋がらないので覚悟すること
- いきなりeSIMからはじめることはできる・・・はず。←調べても見つからなかった
4月26日追記
楽天コールセンターの0800で始まる番号は、フリーダイヤルでした。
なので通話料無料。
朝９：００になった瞬間電話をかけて、すばやく１５とプッシュ。
なんかしゃべったのでもう一回１５をプッシュして、無事に電話繋がりました。
キャンセル手続き無事完了。通話時間５分。
受付は20時までのはずなのに、この間は18時過ぎに受付終了になってて、
夕方だと２時間待ちみたい。かけるなら朝9時だね。