テキストボックス挿入の自動化（Word）

WordVBA VBA自作メソッド

テキストボックス挿入の自動化（Word）

表題のとおり、Wordの文書内にテキストボックスを挿入する作業を自動化したくなったので、やってみた。

きっかけとお題

きっかけ

文字ばっかりのPowerPointスライドを図として挿入するのに、画像で入れてしまったら、文字列の検索が利用できず、不便なので、テキストボックスで再現して挿入しようと思った。

お題

すると、次のような作業が発生することになる。

  • テキストボックスを挿入する
  • 枠線を設定する
  • テキストボックス内の段落書式を設定する
  • テキストボックス自体に段落スタイル（図用）を適用する
  • テキストボックスの寸法（横幅）を決める
  • 図表番号を設定する

ざっとこんな感じ。まあ、テキストボックスの複製自体は、一つ作っておけば、それをたとえば［Ctrl］＋ドラッグで次のやつが作れるんだけれど、図表番号を挿入することを考えると、大した回数発生しない作業とはいえめんどくさい。

そこで、男坂WordVBAの登場ですよ！

要するに、上の作業を1クリックでやりたいわけです。

テキストボックスを挿入するマクロ

まずは、コードを掲載。

リスト１
Option Explicit

Private Const FIGURE_STYLE_1 As String = "My図1"  '……(1)'

Private Const TEXTBOX_STYLE_1 As String = "MyTextBox1"
Private Const TEXTBOX_STYLE_2 As String = "MyTextBox2"

Private Const TEXTBOX_WIDTH As Single = 419.5276  '148ミリ'
Private Const TEXTBOX_HEIGHT As Single = 204.0945 '72ミリ'
Private Const TEXTBOX_MARGIN As Single = 11.33858 '4ミリ'

Public Sub InsertInlineTextBox()
  Dim tgtDoc As Document  '……(2)'
  Set tgtDoc = ActiveDocument
  Dim tb As Word.Shape
  Set tb = tgtDoc.Shapes.AddTextbox( _
                           Orientation:=msoTextOrientationHorizontal, _
                           Left:=0, Top:=0, _
                           Width:=TEXTBOX_WIDTH, _
                           Height:=TEXTBOX_HEIGHT)
  tb.WrapFormat.Type = wdWrapInline  '……(3)'
  With tb    '……(4)'
    With .Line    '……(5)'
      .Visible = msoTrue
      .Weight = 1
      .Style = msoLineSingle
      .ForeColor = vbBlack
    End With
    With .TextFrame    '……(6)'
      .TextRange.Style = TEXTBOX_STYLE_1
      .MarginTop = TEXTBOX_MARGIN
      .MarginBottom = TEXTBOX_MARGIN
      .MarginLeft = TEXTBOX_MARGIN
      .MarginRight = TEXTBOX_MARGIN
    End With
  End With
  Selection.Style = FIGURE_STYLE_1  '……(7)'
End Sub

まず、(1)からの6行（空行除く）、

Private Const FIGURE_STYLE_1 As String = "My図1"

Private Const TEXTBOX_STYLE_1 As String = "MyTextBox1"
Private Const TEXTBOX_STYLE_2 As String = "MyTextBox2"

Private Const TEXTBOX_WIDTH As Single = 419.5276  '148ミリ'
Private Const TEXTBOX_HEIGHT As Single = 204.0945 '72ミリ'
Private Const TEXTBOX_MARGIN As Single = 11.33858 '4ミリ'

これは、後のプロシージャ中で使う定数。

「My図1」とか、「MyTextBox1」、「MyTextBox2」は、全部自作の段落スタイル名。

「TEXTBOX_WIDTH」、「TEXTBOX_HEIGHT」、「TEXTBOX_MARGIN」は、寸法にかかわる値を定数化。

Wordを直接操作するときはミリ単位なんだけれど、VBAのメソッドではポイント単位の指定でわかりにくいので、Word.MillimetersToPointsメソッドで変換した値を定数として設定している。

f:id:akashi_keirin:20210817085043p:plain

次に、(2)からの8行（実質4行）、

Dim tgtDoc As Document
  Set tgtDoc = ActiveDocument
  Dim tb As Word.Shape
  Set tb = tgtDoc.Shapes.AddTextbox( _
                           Orientation:=msoTextOrientationHorizontal, _
                           Left:=0, Top:=0, _
                           Width:=TEXTBOX_WIDTH, _
                           Height:=TEXTBOX_HEIGHT)

で、ひとまずテキストボックスを挿入。

アクティブなドキュメントを変数「tgtDoc」にぶち込み、[Document].Shapes（コレクション）オブジェクトのAddTextBoxメソッドを使う。

「行内」に配置したいのだが、[Document].InlineShapes（コレクション）オブジェクトには、AddTextBoxメソッドがないので、仕方なくこうしている。

つまり、一旦位置を指定している。（引数LeftとTopに0を指定。）

引数WidthとHeightは、文字どおりテキストボックスの幅と高さ。ここでは先に値を定めた定数をそれぞれ渡している。

(3)の

tb.WrapFormat.Type = wdWrapInline

では、tbつまり、ShapeオブジェクトのWrapFormatプロパティからWrapFormatオブジェクトを取得し、そのTypeプロパティにwdWrapInlineという値を設定している。

ちなみに、wdWrapInlineは、WdWrapType列挙体のメンバ。

これで、一旦左上端に設置されたテキストボックスの配置が「行内」になる。

(4)からの15行、

With tb
  With .Line    '……(5)'
    .Visible = msoTrue
    .Weight = 1
    .Style = msoLineSingle
    .ForeColor = vbBlack
  End With
  With .TextFrame    '……(6)'
    .TextRange.Style = TEXTBOX_STYLE_1
    .MarginTop = TEXTBOX_MARGIN
    .MarginBottom = TEXTBOX_MARGIN
    .MarginLeft = TEXTBOX_MARGIN
    .MarginRight = TEXTBOX_MARGIN
  End With
End With

は、テキストボックス自体の書式設定と、テキストボックス内の書式設定。

こういうふうにまとめて書ける、というのはVBAのいいところ。

まず、(5)からの6行、

With .Line
  .Visible = msoTrue
  .Weight = 1
  .Style = msoLineSingle
  .ForeColor = vbBlack
End With

[Shape].Lineプロパティを参照してLineオブジェクトを取得。その各プロパティを設定している。要するに、テキストボックス自体の枠線の調整である。

(6)からの7行、

With .TextFrame
  .TextRange.Style = TEXTBOX_STYLE_1
  .MarginTop = TEXTBOX_MARGIN
  .MarginBottom = TEXTBOX_MARGIN
  .MarginLeft = TEXTBOX_MARGIN
  .MarginRight = TEXTBOX_MARGIN
End With

では、今度は[Shape].TextFrameプロパティを参照してTextFrameオブジェクトを取得。その各プロパティを設定している。

まず、TextRangeプロパティを参照してTextRangeオブジェクトを取得。そのStyleプロパティに、適用したいスタイル名を設定している。当然、当該文書にそのスタイル（この場合は、定数TEXTBOX_STYLE_1の中身、すなわち「MyTextBox1」スタイル。）が存在しなかったら実行時エラーになる。

残りの四つ（「Margin～」）は、テキストボックス内のマージンの設定。

すでに設定済みの定数で設定。

最後に、(7)の

Selection.Style = FIGURE_STYLE_1

で、カーソル位置（つまり、テキストボックスが挿入された段落。）にスタイルを適用する。もちろん、この場合も定数FIGURE_STYLE_1で指定したスタイルが文書に存在しなければ実行時エラーになる。

図表番号を付加するマクロ

これについては、コチラをどうぞ。

完成したマクロ

リスト２
Private Sub setTextBoxMain()
  Call TextBoxUtil.InsertInlineTextBox  '……(1)'
  Call Selection.MoveRight(wdCharacter, 1, wdMove)  '……(2)'
  Call Selection.InsertAfter(Chr(13))
  Call UsefulMacros.SetCaption("図", wdCaptionPositionBelow)  '……(3)'
End Sub

(1)の

Call TextBoxUtil.InsertInlineTextBox

で、まずはテキストボックスを文書内に挿入する。

TextBoxUtilというのは、リスト１のInsertInlineTextBoxメソッドを書いた標準モジュールの名前。

(2)からの2行、

Call Selection.MoveRight(wdCharacter, 1, wdMove)
Call Selection.InsertAfter(Chr(13))

(1)の直後の段階では、カーソルがテキストボックスの左側にあるので、

f:id:akashi_keirin:20210817085046p:plain

(2)からの2行、

Call Selection.MoveRight(wdCharacter, 1, wdMove)  '……(2)'
Call Selection.InsertAfter(Chr(13))

でカーソルを一つ右に動かし、新しい段落を追加する。

f:id:akashi_keirin:20210817085049p:plain

最後に(3)の

Call UsefulMacros.SetCaption("図", wdCaptionPositionBelow)

で図表番号を追加。

「UsefulMacros」というのも、自作の標準モジュール名。SetCaptionメソッドはその中にある。（そろそろ「UsefulMacros」モジュールから切り離さないといけないと思っている。）SetCaptionメソッドのコードはコチラをどうぞ。

全部実行すると、

f:id:akashi_keirin:20210817085052p:plain

こうなる。

ちなみに、PDF化した後でも、

f:id:akashi_keirin:20210817085055p:plain

ちゃんと検索に引っかかる。ありがたい。

おわりに

Wordのマクロづくりは、楽しいなあ。

【意味】Paragraphオブジェクトの謎挙動【不明】（Word）

WordVBA VBA覚書

【意味】Paragraphオブジェクトの謎挙動【不明】

WordのVBAで、ParagraphオブジェクトのRange.Textプロパティを書き換えたら、わけのわからないことが起こったので報告。

もとの文書

もとのWord文書は、

f:id:akashi_keirin:20210808163624p:plain

このとおり。何の変哲もない、至ってフツーのドキュメントである。

f:id:akashi_keirin:20210808163629p:plain

1段落目のスタイルは、「表題」。

f:id:akashi_keirin:20210808163632p:plain

2段落目のスタイルは、「副題」である。

各段落のRange.Textプロパティを書き換えるマクロ

この文書に対して、次のようなマクロを実行してみる。

リスト１
Private Sub test01()
  Dim tgtDoc As Document
  Set tgtDoc = ActiveDocument
  Dim para As Paragraph
  Dim tmp As String
  For Each para In tgtDoc.Paragraphs
    tmp = para.Range.Text  '……①'
    para.Range.Text = tmp  '……②'
    Debug.Print para.Range.Text  '……③'
  Next
End Sub

アクティブドキュメントからParagraphsコレクションを取得し、Paragraphオブジェクト一つ一つに対して、まずはそのRange.Textプロパティを取得し（①）、直後に取得した文字列をRange.Textプロパティにセットし直す（②）、というアホみたいなマクロだ。

また、一連のアホな処理が終わった後は、ParagraphオブジェクトのRange.Textプロパティの値をイミディエイトに表示する（③）。

さて、こいつを実行するとどうなるとお思いだろうか？

衝撃の実行結果

実は、次のような奇想天外な結果が得られる。

上記リスト１の①のところを実行した時点では、当然何も起こらない。

問題は、②の実行後である。

f:id:akashi_keirin:20210808163636p:plain

なんと、こうなってしまうのである。

なんでやねん。

続けて③を実行してみる。

当然1段落目の文字列が表示されると思いきや、

f:id:akashi_keirin:20210808163640p:plain

このように、2段落目の文字列が表示されるのである。

いつの間にか、変数paraが2段落目のParagraphオブジェクトを指し示すようになっているのである。

おわりに

どうも、私はまだParagraphオブジェクトについて、満足に理解できていないらしい。

なんとも、WordのVBAというものは、

男坂

である！

f:id:akashi_keirin:20210808163653p:plain

VBAで文書にインライン画像を挿入する（Word）

VBA覚書 WordVBA

VBAで文書に画像を挿入するときの注意

最近、Wordでマニュアルとか手順書の類を作成することがやたら増えた。

PDF配布を前提とすると、画像をふんだんに盛り込むことができるので、非常に良いのだが、当然画像の挿入が非常にめんどくさくなってくる。

そこで、VBAで画像挿入を楽にできるようにしようとした。

そのときに、ちょっと予定外のことが起こったので、報告。

カーソル位置にインライン画像を挿入するマクロ

まずは、カーソル位置にインライン画像を挿入するマクロ。

ドキュメントのあるフォルダ内に、「img」というフォルダがあり、その中に「アホの坂田.png」という画像ファイルがあるとする。

リスト１
Private Sub test01()
  Dim imgPath As String
  imgPath = ThisDocument.Path & "\img\アホの坂田.png"
  Dim ilShp As InlineShape
  Set ilShp = Selection.Range.InlineShapes.AddPicture(imgPath)
  Call ilShp.Select
End Sub

カーソル位置のRangeオブジェクトのInlineShapesプロパティからInlineShapesコレクションオブジェクトを取得し、そのAddPictureメソッドにより、画像を挿入する。

AddPictureメソッドの返り値はInlineShapeオブジェクトなので、InlineShape型の変数ilShpで受け取り、最後にSelectメソッドを実行して、挿入した画像を選択状態にするようにしている。

リスト１を実行すると、当然、

f:id:akashi_keirin:20210807151631p:plain

こうなる。

実にめでたい。

画像の大きさを変えようとすると悲劇が起こる

しかし……。

f:id:akashi_keirin:20210807154319g:plain

これは全然だめである。

画像の書式を調べてみる。

f:id:akashi_keirin:20210807152008p:plain

なんと、デフォルトでは「縦横比を固定する」のチェックが外れているのである。なんでやねん。

LockAspectRatioプロパティ

画像の縦横比の固定を司るのは、[InlineShape].LockAspectRatioプロパティである。

画像を挿入するマクロ、リスト１を、次のように変えて実行してみる。

リスト２
Private Sub test01()
  Dim imgPath As String
  imgPath = ThisDocument.Path & "\img\アホの坂田.png"
  Dim ilShp As InlineShape
  Set ilShp = Selection.Range.InlineShapes.AddPicture(imgPath)
  Call ilShp.Select
  Debug.Print ilShp.LockAspectRatio
End Sub

画像挿入直後のLockAspectRatioプロパティの値をイミディエイトに出力する。

結果は、

f:id:akashi_keirin:20210807151641p:plain

このとおり、「0」と出た。

オブジェクト ブラウザーで調べると、

f:id:akashi_keirin:20210807151645p:plain

LockAspectRatioプロパティはMsoTriState型。

同様にオブジェクト ブラウザーで調べると、MsoTriState列挙体のメンバは、

f:id:akashi_keirin:20210807151648p:plain

このとおり。

つまり、LockAspectRatioプロパティのデフォルト値はmsoFalseだとわかる。

これは、タンザニアのイカンガーである。

コードの修正

そこで、リスト１を次のように書き換える。

リスト３
Private Sub test01()
  Dim imgPath As String
  imgPath = ThisDocument.Path & "\img\アホの坂田.png"
  Dim ilShp As InlineShape
  Set ilShp = Selection.Range.InlineShapes.AddPicture(imgPath)
  ilShp.LockAspectRatio = msoTrue
  Call ilShp.Select
End Sub

画像を挿入するや否や、LockAspectRatioプロパティの値をmsoTrueにするのである！

実行結果

f:id:akashi_keirin:20210807153116g:plain

当然、画像の書式は、

f:id:akashi_keirin:20210807152012p:plain

このとおり、ちゃんと「縦横比を固定する」にチェックが入っている。

うむ、万全である！

おわりに

手動で動画を挿入すると、普通に「縦横比を固定する」にチェックが入っているものだから、ちょっと焦りましたよ。

関連記事

akashi-keirin.hatenablog.com

フォルダのサイズを返すFunction

ちょい書きマクロ VBA一般 VBA自作メソッド

フォルダのサイズを返すFunction

フォルダのサイズを返すFunctionを作ってみた。

FileSystemObjectを使う

だいぶ前に、Twitterでノンプロ研の某氏が言っていたのを思い出した。

たしかに、Windowsのエクスプローラーでフォルダを右クリックして「プロパティ」を表示しても、フォルダのサイズはわからなくはないのだが、ファイル数が多いときに異様に時間がかかる。

FileSystemObjectを使えば一瞬なのだ。

作ったコード

ちょっとだけ工夫をして、次のようなコードにした。

リスト１
Option Explicit

Public Enum FiUnit
  fiByte
  fiKiloByte
  fiMegaByte
  fiGigaByte
  fiTeraByte
End Enum

Dim fsObj As Object

Public Function GetFolderSize( _
            ByVal a_FolderPath As String, _
   Optional ByVal a_Unit As FiUnit = fiByte) As Variant
  Dim ret As Variant
  ret = 0
  If fsObj Is Nothing Then Set fsObj = CreateObject("Scripting.FileSystemObject")
  Dim tgtFolder As Object
  'パス間違いだったら-1を返してExit'
  If Not fsObj.FolderExists(a_FolderPath) Then ret = -1: GoTo ReturnValue
  Set tgtFolder = fsObj.GetFolder(a_FolderPath)
  ret = tgtFolder.Size
  ret = ret / (1024 ^ a_Unit) '……(*)'
ReturnValue:
  GetFolderSize = ret
End Function

第2引数で、自作の列挙体を指定できるようにした。

んで、たとえばfiKiloByteが渡されたら、fiKiloByteの実体は2なので、Scripting.FolderオブジェクトのSizeプロパティが返した値を1024 ^ 2で割ることになり、キロバイト単位になる。

使ってみる

このFunctionを使って、私のSSD内のMETALLICAフォルダのサイズを表示してみた。

Byte単位とGigaByte単位で表示させてみた結果が、

f:id:akashi_keirin:20210723194740p:plain

これ。（英語が変だったら教えろえてください。）

エクスプローラの「プロパティ」で表示させてみた結果は、

f:id:akashi_keirin:20210723194748p:plain

これ。

当たり前だけど、完全一致。

おわりに

FileSystemObjectって、便利だね。

VBAで段落前後のスペースを操作する（Word）

WordVBA VBA覚書

VBAで段落前後のスペースを操作する（Word）

軽くハマったので報告。

何がしたかったか

Googleフォームで集めたアンケート結果の自由記述の部分をWordに移して整形したかった。

ただずらずらと並べただけだと読みづらいので、一人分づつ記述の間にスペースを空けて読みやすくしたい。

単にこれだけなら、段落の後ろに0.5行とか間隔を空けるようなスタイルを作って、そいつを全体に適用すればよい。

しかし、このやり方だと、回答の中で改行（段落）しているものがあると、全部隙間が空いてしまって具合が悪い。

幸い、改行を含む回答を、GoogleスプレッドシートからテキストファイルとかWordドキュメントにコピペすると、回答全体の頭とケツをダブルクオーテーションで括った形になっている。

……ということは、次のように処理すれば良いと考えたのだ。すなわち、

  1. 回答全体をWordドキュメントにコピペする。
  2. 各段落に対して、後ろに0.5行の間隔を空けるスタイルを当てていく。
  3. 段落の先頭に「"」（ダブルクォーテーション）がある段落については、間隔を「0」にする。
  4. 置換機能でダブルクォーテーションを削除する。

これで万全だと思った。

しかし、だめだったのである。

3.のところがうまくいかなかったのだ。

Paragraph.Range.ParagraphFormatオブジェクトのLineUnitAfterプロパティとか、SpaceAfterプロパティに値を設定するだけのかんたんなお仕事だと思ったんですが、うんともすんとも言いやがらねえんです。

解決までの道

ぐりぐりやっているうちに偶然（笑）解決したので、報告します。

スプシからWordに貼り付ける

スプシからWordにテキストを貼り付ける。

f:id:akashi_keirin:20210709091342p:plain

こうなる。セルの中に改行がある場合は、上述の通り、回答の先頭とケツに「"」が入る。

段落スタイルを当てる

この二つの段落に、自作の「My本文列挙1」スタイルを当てたところ。

f:id:akashi_keirin:20210709091345p:plain

自作の「My本文列挙1」の設定は次のとおり。

f:id:akashi_keirin:20210709091348p:plain

このスタイルを当ててあるので、当然この段落の書式は、次のとおり。

f:id:akashi_keirin:20210709091353p:plain

したがって、当然、二つの段落はバラバラになる。

VBAで段落書式の変更を試みる

リスト１
Private Sub test01()
  With Selection.ParagraphFormat
    .SpaceAfter = 0
  End With
End Sub

ParagraphFormatオブジェクトのSpaceAfterプロパティを「0」にするというだけのコードである。

このリスト１を、一つ目の段落にカーソルを置いて実行してみる。

f:id:akashi_keirin:20210709091357p:plain

このとおり、何も変わっていない。

段落書式を確認する。

f:id:akashi_keirin:20210709091400p:plain

なんてこった。何も変わっちゃいねえ。

異変起こる

では、と今度は先ほどのリスト１を次のように改めてみる。

リスト２
Private Sub test01()
  With Selection.ParagraphFormat
    .LineUnitAfter = 0
  End With
End Sub

こいつを実行してみた。

f:id:akashi_keirin:20210709091403p:plain

しかし、ダメ。やっぱり、なーーーんも変わりゃあせん。

しかし、私は見逃さなかった！

f:id:akashi_keirin:20210709091407p:plain

段落書式の「段落後」の値が〝ポイント表記〟になっていることを！（偶然ですけどね。）

どうやら、LineUnitAfterプロパティを設定すると、なぜか表記がポイント単位に変わるらしい。

も、もしかして……。

そして、解決へ……

今度は、リスト２を次のようにした。

Private Sub test01()
  With Selection.ParagraphFormat
    .LineUnitAfter = 0
    .SpaceAfter = 0
  End With
End Sub

一旦「段落後」の値をポイント表記に変えておき、しかる後にSpaceAfterプロパティに「0」をセットしてみたのである!!!!!!!!

f:id:akashi_keirin:20210709091410p:plain

うおおおおおおおおお！

でけたあああああああ！

おわりに

WordのVBAは、実に多くの試練をわれわれユーザーに投げかけてくる。

WordVBA……。それは、まさに……、

男塾

である！

isKanjiメソッドを久々に修正した

VBA一般 VBA自作メソッド

漢字かどうかを判定するFunction

まじめに手直しした。

元のコード

コチラが、元のisKanjiメソッドのコード。

リスト１
Public Function isKanji(ByVal targetCharacter As String) As Boolean
  Dim char As String
  char = targetCharacter
  If Len(char) <> 1 Then Call Err.Raise( _
                                  Number:=10001, _
                                  Description:="引数は1文字のみにしてください。")
  If Asc(char) > 0 Then isKanji = False: Exit Function
  If Asc(char) >= &H889F Then
    isKanji = True
  Else
    isKanji = False
  End If
End Function

うーむ……。実にテキトーである。

これでは、第2水準以降とか、全然対応できないではないか。

で、ちょっとまじめに書き直してみた。

文字コード表は、コチラのお世話になりました。いつもありがとうございます。

書き直したコード

修正したisKanjiメソッドのコードがコチラ。

リスト２
Private Function isKanji( _
             ByVal a_Char As String) As Boolean
'///漢字だったらTrueを返す。'
  Const SP_KANJI = "ヽ ヾ ゝ ゞ 〃 仝 々 〆"
  Dim arr() As String
  arr = Split(SP_KANJI)
  isKanji = True
  Dim char As String * 1
  char = a_Char
  Dim i As Long
  '特殊文字は漢字と見なす'
  For i = LBound(arr) To UBound(arr)
    If char = arr(i) Then Exit Function
  Next
  '第4レベルの漢字判定'
  If CInt(Asc(char)) > CInt(&HFC4B) Then
    isKanji = False
    Exit Function
  End If
  If CInt(Asc(char)) > CInt(&HFA5B) Then Exit Function
  '第3レベルの漢字判定'
  If CInt(Asc(char)) > CInt(&HEAA4) Then
    isKanji = False
    Exit Function
  End If
  If CInt(Asc(char)) > CInt(&HE039) Then Exit Function
  '第2レベルの漢字判定'
  If CInt(Asc(char)) > CInt(&H9FFC) Then
    isKanji = False
    Exit Function
  End If
  If CInt(Asc(char)) > CInt(&H989E) Then Exit Function
  '第1レベルの漢字判定'
  If CInt(Asc(char)) > CInt(&H9872) Then
    isKanji = False
    Exit Function
  End If
  If CInt(Asc(char)) > CInt(&H889E) Then Exit Function
  'ここまで引っかからなかったらFalse'
  isKanji = False
End Function

文字コード表とにらめっこしながら、がんばったよ！

使ってみる

次のコードで実験

リスト３
Private Sub test10()
  Dim char As String * 1
  char = "黑"  '……(*)'
  Debug.Print char & " : "; isKanji(char)
End Sub

(*)のところで、変数charに色んな文字を入れてみて実験。

f:id:akashi_keirin:20210619173324p:plain

f:id:akashi_keirin:20210619173320p:plain

うむ。

おわりに

こんなもんでいいのではなかろうか。

FileSystemObjectのCreateFolderメソッドで半角スペースで終わるフォルダ名のフォルダを作ったらヤバい

VBA覚書 Win64/32API利用

FileSystemObjectでフォルダを作るときに気をつけた方がいいこと

ちょっと恐怖体験をしたので報告。

フォルダ名の最後の文字が半角スペースになるようなフォルダを作る

Scripting.FileSystemObjectオブジェクトの、CreateFolderメソッドを使ってフォルダを作るときに、フォルダ名の末尾を半角スペースにしてみる。

リスト１
'Microsoft Scripting Runtime 参照設定済み'
Private Sub test00()
  Dim fsObj As New Scripting.FileSystemObject
  Call fsObj.CreateFolder(ThisWorkbook.Path & "\ち～んｗ ")
End Sub

こいつを実行すると、フォルダ内が

f:id:akashi_keirin:20210607202817p:plain

こうなる。

一見すると、「ち～んｗ」という名前のフォルダが出来ただけのようである。

しかし……。

f:id:akashi_keirin:20210607202832g:plain

ファッ？！

なんと、

f:id:akashi_keirin:20210607202820p:plain

こんなふうになってしまうのである！

一見、全く同名のフォルダが出来たようであるが、

f:id:akashi_keirin:20210607202823p:plain

f:id:akashi_keirin:20210607202826p:plain

おわかりだろうか。

下の方は、「ｗ」の後ろがちょっと長い。

下の方は、「ち～んｗ」の後ろに半角スペースが入っているのである。

普通、こんな名前のフォルダは作れないが、どうもFileSystemObjectを使うと、こういうわけのわからないフォルダが作れてしまうようなのである。

恐ろしいこと

単に、〝ちょっと普通には作れないフォルダが作れちゃう〟というだけなら、何ら実害はない。

しかし、恐ろしいことに、こうして出来た変なフォルダ（今回の場合だと「ち～んｗ 」フォルダ。）は、次のような事態を招くのである！

f:id:akashi_keirin:20210607202835g:plain

け、消せねえ……。

めっちゃ困るのである！

救いの手がさしのべられた

どうしてもフォルダが消せず、困っていたところ、踊るVBEの中の人が救いの手をさしのべてくださった。

曰く、

WinAPI使ったら消せるよ！

と。

ありがたや～！

踊る氏に、教えてもらったWinAPI関数が、コチラ。

Private Declare Function RemoveDirectory Lib "kernel32" Alias "RemoveDirectoryA" (ByVal lpPathName As String) As Long

こいつを宣言セクションに書いて、次のコードで実行してみた。

リスト２
Private Sub test01()
  Call RemoveDirectory(ThisWorkbook.Path & "\ち～んｗ \")
End Sub

これで、無事に消えてくれました。

ありがとう、踊るさん！

おわりに

さすがや……。