ExcelからSQLite3を操作する方法(4.データの挿入)

前回予告どおり今回は取得したMP3タグデータをExcelへの転記ではなくSQLiteデータベースに取り込んでみようと思います。

SQLのInsert文でデータを取り込む

Sub GetMusicFileProperty()
    n = 0

    ReDim MusicFileProperty(n)
    FileSearch "G:\Music\"

    ReDim Preserve MusicFileProperty(UBound(MusicFileProperty) - 1)
    
'①今回変更部分-------------------    
    SQLite3dll_Connect
    SQLite_MusicData_Insert
'------------------------------
End Sub

上記は前回作成した「GetMusicFileProperty」です。

excellover.hatenablog.com

①の部分はセルへの転記のためのコードが記載されていましたが、今回新たにSQLiteへのデータ挿入のための

SQLite_Music_Insert」を作成して置き換えました。

Sub SQLite_MusicData_Insert()
     Dim SQLiteDB_Handle As Long
     Dim SQLiteFullPath As String
     Dim myStmtHandle As Long
     Dim mySQL As String
     SQLiteFullPath = ThisWorkbook.Path & "\MusicDatabase.db3"
     SQLite3Open SQLiteFullPath, SQLiteDB_Handle
     
     Dim i As Long
     For i = 0 To UBound(MusicFileProperty)

'②MP3タグを利用してSQL文を作成    
          mySQL = "Insert Into MusicDatabase Values(" & _
          "'" & MusicFileProperty(i)(0) & "'," & _
          "'" & MusicFileProperty(i)(1) & "'," & _
          "'" & MusicFileProperty(i)(2) & "'," & _
          "'" & MusicFileProperty(i)(3) & "'," & _
          "'" & MusicFileProperty(i)(4) & "'," & _
          "'" & MusicFileProperty(i)(5) & "'," & _
          "'" & MusicFileProperty(i)(6) & "'," & _
          "'" & MusicFileProperty(i)(7) & "'," & _
          "'" & MusicFileProperty(i)(8) & "'," & _
          "'" & MusicFileProperty(i)(9) & "')"
          SQLite3PrepareV2 SQLiteDB_Handle, mySQL, myStmtHandle
          SQLite3Step myStmtHandle
          SQLite3Finalize myStmtHandle
     Next i
    SQLite3Close SQLiteDB_Handle 
End Sub

今回は記載していませんが、モジュールレベル変数としてMusicFilePropertyを宣言していて、その中にMP3タグデータが格納されています。

②データ挿入のSQLの構文は

Insert Into テーブル名 Values(挿入データ)

上記はテーブルの全ての列にデータを挿入する際の構文です。

実際のテーブルの列の並びと同じように挿入データを記載します。

今回のテーブルのデータ型は2列目(Year)と6列目(No)がInteger型で作成していますが、

SQL文内では文字列として挿入の表現をしています。

あまり行儀は良くないかもしれませんが、テーブル側の型に合わせて自動で変換してくれているようです。

文字列の挿入する場合は挿入するデータを「’(シングルコーテーション)」で囲ってください。

SQL文が完成後は以前にご紹介したテーブル作成のCreate分と同じように

・SQLite3PrepareV2

・SQLite3Step

・SQLite3Finalize

以上3つを順番に実行すればSQLiteデータベースにデータ挿入されます。

ちなみに今回のコードでは返り値を受けていませんが、上記3つのSQLite構文はFunctionなので返り値を調べることで正常終了したかエラーが発生しているのか判定することが出来ます。  

まとめ

お作法さえ分かってしまえば、Accessへ挿入するときと殆ど変わらない手順で実行することが出来ることがわかりました。

ここまででSQLiteデータベースの作成、MP3タグデータの収集、収集したデータをSQLiteデータベースへの挿入までが完成しました。

次回はSQLiteデータベースからデータを抽出してExcelへ転記してみようと思います。


SQLiteは日付・時間型の処理がちょっとややこしいみたいなので、いったん文字列型で挿入する逃げを打っています。

ここは調べて対応するつもりです。

日付をコピペすると違う日付になってしまう時の対応

先日こんな事例に遭遇しました。

f:id:ExcelLover:20180908225644j:plain

・あるブックにDate関数で作られた日付がある。

・その日付をコピーして別のブックに値で貼り付け。

・値貼付けした後で書式を「日付」に変更した。

・元のブックの日付と異なる日付が表示された。

久しぶりに???てなりましたよ。

関数の内容がおかしいのかと疑ってトレースしていってもあってるように見える。

しばらく試行錯誤してるうちにあるオプション設定のことを思い出しました。

1904年から計算する

またまた豪快なネタバレでスタートですが、

Excelには「1904年から計算する」というオプションがあります。

元のブックでこの設定がされていたため今回の症状が発生しました。

このオプションは一体何のためにあるのでしょうか?

Macintoshとの互換性

Microsoftのサポートサイトに下記のような記述があります。

Microsoft Excel for Macintosh は、デフォルトでは 1904 年を基準とした日付方式を使用しています。初期の Macintosh コンピュータの設計により、1904 年 1 月 1 日より前の日付はサポートされていませんでした。この設計は、1900 年がうるう年ではないことに関連する問題を防止することが目的でした。1900 年を基準とした日付方式に切り替えると、Excel for Macintosh で 1900 年 1 月 1 日からの日付がサポートされます。

ではこのオプションを設定するとどのような変化があるのでしょうか。

それについても同じくMicrosoftサポートサイトに記述がありました。

1900 年を基準とした日付方式では、サポートされる最初の日付は 1900 年 1 月 1 日です。日付を入力すると、その日付は 1900 年 1 月 1 日からの経過日数を表すシリアル値に変換されます。たとえば、1998 年 7 月 5 日と入力すると、その日付は Excel によってシリアル値 35981 に変換されます。

・・・

1904 年を基準とした日付方式では、サポートされる最初の日付は 1904 年 1 月 1 日です。日付を入力すると、その日付は 1904 年 1 月 1 日からの経過日数を表すシリアル値に変換されます。たとえば、1998 年 7 月 5 日と入力すると、その日付は Excel によってシリアル値 34519 に変換されます。

・・・

2 つの日付方式の日付の差は 1,462 日です。つまり、1900 年を基準とした日付方式の日付のシリアル値は、1904 年を基準とした日付方式の同じ日付のシリアル値よりも常に 1,462 日分大きくなります。1,462 日は、うるう年を 1 回含む 4 年と 1 日に等しくなります。

Microsoftのサイトにしては珍しくわかりやすく求めている完璧な答えが記載されていることに驚いています。

今回僕が遭遇した例で見ていくと コピー元のブック→1904年設定 2018年8月29日の表示で シリアル値は41879

コピー先のブック→1900年設定 上記のシリアル値を貼り付け それを日付の書式を設定。 Microsoftのサイトの解説の通り、 元のブックより1,462日前の日付として認識されますので、2014年8月28日として表示。

まとめ

この元ブックを制作した人が何の意図があって、1904年設定にしたのか今となっては謎ですが。 (昔はMacintoshがあったのか )

なかなかお目にかかれない症状に出くわしたのは純粋に面白かったですが。

Microsoft サポート
Excel の 1900 年を基準とした日付方式と 1904 年を基準とした日付方式の違いについて

横方向(列単位)への並び替えの方法

先日こんなつぶやきを見かけました。

マジで?

この作業をするときは、縦方向に並び替えてから行列を入れ替えて貼り付けたりしてますよ。

早速調べてみました。

オプションで横方向に設定変更

縦方向(行単位)の場合はこんな感じです。 f:id:ExcelLover:20180825124331j:plain

同じ資料を横方向にした場合はこんな感じです。
f:id:ExcelLover:20180825124221j:plain

早速実際に並び替えてみます。

まず並び替えたい範囲を選択します。
f:id:ExcelLover:20180825124358j:plain

ヘッダー部分は選ばないようにしてください。(※氏名・得点部分)

「データ」タブから「並び替え」を選択
f:id:ExcelLover:20180825124437j:plain

「オプション」を選択
f:id:ExcelLover:20180825124456j:plain

「列単位」を選択
f:id:ExcelLover:20180825124511j:plain

並び替えのキー・条件を選択
f:id:ExcelLover:20180825124523j:plain
オプションで「列単位」を選択すると、右上の「先頭行をデータの見出しとして使用する」がグレーアウトになるため、最初の並び替え範囲を選択する際にヘッダー部分を選ばないようにしています。

まとめ

頻度の高い作業ではないかもしれませんが、この機能を使わずに並び替えようと思うと3手間ぐらいかかりますので、頭の片隅に置いておくと良いですね。

並び替えというとっても基礎的な操作でもこんな発見があるなんて、Excelは奥深くて楽しいです。

VBAでの改行の方法

VBAでの改行の方法

メッセージボックス(msgbox)で表示する文章が長くなってくると、見やすくするために改行を行いたときがあります。

VBAには改行を表現が何種類か用意されています。

それぞれの違いを交えながら紹介したいと思います。

改行表現一覧

定数 キャラクター・コード 意味
vbCr Chr(13) キャリッジ・リターン。古いMac OS
vbLf Chr(10) ライン・フィード。Unix系、新しいMac OS
vbCrLf Chr(13)、Chr(10) キャリッジ・リターン/ラインフィード
Windows
vbNewLine Chr(13)、Chr(10)またはChr(10) 実行中のOSに応じた標準の改行文字を返す

僕は今まではvbCrLfを使用していました。

ところでこのvbCr(キャリッジ・リターン)とvbLf(ライン・フィード)とは何なんでしょうか?

キャリッジ・リターンとライン・フィード

wikipedia先生によると元々の由来は

これらの用語はタイプライターが由来である。タイプライターでは印字装置は固定され、紙の方が上下左右に移動することで、文字送りや行送りが行われる。英語などの左横書きにおける「キャリッジリターン」とは、紙を固定して移動する装置(キャリッジ)を元の位置に戻す(リターン、つまり紙の左端に印字装置が来る)ことである。「ラインフィード」とは紙を必要な行(ライン)だけ上に送る(フィード、つまり下の行に印字装置が来る)ことである。

プログラム的にはこんな感じ。

・キャリッジ・リターン⇨カーソルを先頭に戻す

・ライン・フィード⇨カーソルを下の行の同じ位置に移動 f:id:ExcelLover:20180823171801j:plain

2つ合わせて改行と同じ意味になります。

では実際にExcel上で使用してみるとどうなるのでしょうか

Excelでの表示の違い

Sub 改行()
'セル代入
     Range("B2").Value = "AAA" & vbCr & "BBB"
     Range("B3").Value = "AAA" & vbLf & "BBB"
     Range("B4").Value = "AAA" & vbCrLf & "BBB"
     Range("B5").Value = "AAA" & vbNewLine & "BBB"
     
'メッセージボックス
     MsgBox "AAA" & vbCr & "BBB"
     MsgBox "AAA" & vbLf & "BBB"
     MsgBox "AAA" & vbCrLf & "BBB"
     MsgBox "AAA" & vbNewLine & "BBB"
End Sub

上記コードの実行結果が下記です。

f:id:ExcelLover:20180823172854j:plain

メッセージボックスでは4つ全てのコードが実際に改行されていますが、セルに書き込むとvbCrのみ改行されていません。

これはキャリッジ・リターンの本来の働きをしているのかなと推測します。

他の3つについては同じようにセルに書き込んでも改行されていますが、vbLfとvbCrLf・vbNewLineでは少し中身が異なっています。

D列の数値を見て頂くとわかりやすいですが、vbCrLf・vbNewLineについては改行コードが2文字(13、10)入力されています。

一方vbLfと手入力で改行した場合は改行コードが1文字(10)だけ入力されています。

手入力との整合性を取ろうと思うとVBA上で使用するのは

vbLf を使用すれば良いのではないでしょうか。

VBAのコード自体の改行方法

ちなみにVBAのコード自体の改行方法は

     MsgBox "AAABBB" _
          , vbInformation

改行したい位置で「 _(半角スペース・アンダーバー)」で改行できます。

まとめ

今回記事をまとめるにあたって調べていて、改行コード自体も文字数に数えられるということにちょっとびっくりしました。

文字数をキーにした仕組みを作るときに詰まりそうなネタですので覚えておくと助かりそうな気がします。

例によって偉大なる先輩達を参考に

thom.hateblo.jp

www.relief.jp

[asin:4797396989:detail]

Excelでドラム演奏(mciSendString関数でmp3再生)

好きなんです、ドラム(1回しか叩いたこと無いけど)。

叩きたくなりますよね、ドラム(ドラムマニアは何度か)。

無理からにExcelで作ってみました、ドラム(不安定だけど)。

どんなもの

事前にキーボードのキーと再生する音の組み合わせを決めておきます。

指定していたキーを押すと組み合わせていた音が再生されます。

その再生する音をドラムのシンバルやスネアの音にしておくと

さながらドラムのようになる、というものです。

用意したもの

・ドラムの音

こちらのサイトでアカウント登録して取得しました。

www.samplephonics.com

(海外サイトへのアカウント登録する危険性・ダウンロードの危険性に関してはご自分でご判断を)

・設定画面 f:id:ExcelLover:20180811232747j:plain

A列:キーボードのキー(コードの中では使用しません。見た目のわかり易さのみ)

B列:A列記載のキーのキーコード。この数字でどのキーを押下したか判断します。

C列:キーを押下した際に鳴らす音声ファイルのフルパスを指定。

コード

Option Explicit
'①
Public Declare Function mciSendString Lib "Winmm.dll" Alias "mciSendStringA" (ByVal lpMciComm As String, ByVal lpMciRetString As String, ByVal lpRetLength As Long, ByVal CallBackhWnd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long
Dim myDic As Dictionary
'-------------------------------------------------------------------------------
Sub Excel_Drum_Start()
     Dim myPath As String
     Dim DrumSoundFiles As Range
     Dim DrumSoundFile As Range
     Dim i As Long
     
     Set myDic = New Dictionary
     Set DrumSoundFiles = Range("C2:C8")
     For Each DrumSoundFile In DrumSoundFiles
          myPath = """" & DrumSoundFile.Value & """"
'②                        
          mciSendString "Open " & myPath & " alias Drum" & i, vbNullString, 0, 0
          myDic.Add DrumSoundFile.Offset(, -1).Value, "Drum" & i
          i = i + 1
     Next                 
     Drum_Play
'⑦                    
     mciSendString "Close all", vbNullString, 0, 0
End Sub
'-------------------------------------------------------------------------------
Sub Drum_Play()
     Dim PlayFlag As Boolean
     Dim myKey As Variant
     PlayFlag = True
'③     
     Do While PlayFlag = True
          For Each myKey In myDic
'④                        
               If GetAsyncKeyState(myKey) And &H8000 Then
                    mciSendString "Play " & myDic.Item(myKey) & " from 0", vbNullString, 0, 0
'⑤                            
               ElseIf GetAsyncKeyState(27) Then
                    PlayFlag = False
               End If
'⑥                        
               Sleep 10
          Next
          DoEvents
     Loop
End Sub

ユーザーフォームを1つ用意して、その上にコマンドボタンを1つ設定しました。 コマンドボタンを押下すると上記コードの「Excel_Drum_Start」が実行されます。

API関数を3種類使用しています。

・mciSendString…音声ファイルを再生するための関数。
・Sleep…ループ処理の途中で処理を指定時間休止させることが出来ます。
・GetAsyncKeyState…押下されたキーを取得する関数

②mciSendString関数は音声ファイルを開く・再生する・閉じるの3段階構成です。 まずは音声ファイルを開く

mciSendString "Open ファイルのフルパス Alias 〇〇〇 ,vbNullString,0,0"

Alias 〇〇〇…今後、ファイルの再生・閉じるを行う際にはこの〇〇〇で処理する音声ファイルを指定する。
毎回フルパスを指定しなくて良くなる。変数に代入している感じでしょうか。 〇〇〇は任意で設定してください。

キーコードと指定した〇〇〇をDictionaryオブジェクトに代入。 キーコードをキーにして組み合わされた〇〇〇を抽出します。

③ここから実際の音声再生です。 「ESC」ボタンを押下するまではずーっとループしっぱなしです。

④押下されたキーの判定を行っています。
Dictionaryオブジェクトに格納されたキーコードと押下されたキーのキーコードが一致したときに、 Dictionaryオブジェクト内で関連付けられた〇〇〇の音声ファイルを再生します。

mciSendString "Play 〇〇〇 from 0 ,vbNullString,0,0"

第1引数にPlay + ファイルのAlias(〇〇〇)。from 0は音声ファイルの最初から再生の意味。 第2ー第4までの引数はこのままで(よくわからん)

⑤キーコード27はEscボタンを意味します。Escボタンを押下したときにフラグを立ててループ処理を抜けます。

⑥Escボタンを押すまでは無限ループですので、Sleepを間に挟むことでCPUが動きっぱなしになることを防ぎます。

⑦mciSendString関数のお作法、ファイルを閉じます。

mciSendString "Close 〇〇〇 from 0 ,vbNullString,0,0"

上記のように1つずつAliasを指定して閉じる方法もありますが、今回のコードのように「Close all」と記載することで開いている音声ファイルを全て閉じることができるようです。

まとめ

なかなか面白いものが出来ました。キーを押し続けるとデスメタルバンドのドラマーさながらの高速連打を堪能できます。
CRYPTOPSY - Worship Your Demons (OFFICIAL VIDEO) - YouTube
デスメタルの演奏風景が流れますから、イヤな人は要注意

今回使用したmciSendString関数は現在チマチマと作り続けている、Excel Playerでも使用する予定ですのでその予行演習も兼ねていました。

おまけ

キーを3回連続で押すと自動的にデスメタルドラマーと化す(連打が止まらない)ボタンがあったり、再生できないmp3ファイルがあったりと課題も見つかりました。

解決できれば良いですけど、最低限自分がやりたいことの実現が最優先ですのでホドホドに調べていきます。

参考資料

今回こちらの動画を見て作ってみようと思いたちました。
www.youtube.com
shadowslasheizan.blog114.fc2.com

Excel VBA アクションゲーム作成入門 Excel 2007/2003/2002 対応

Excel VBA アクションゲーム作成入門 Excel 2007/2003/2002 対応

指定フォルダ内の全てのMP3ファイルのタグ情報を抽出する方法

今回は以前にご紹介した以下のネタの合わせ技で、

excellover.hatenablog.com

excellover.hatenablog.com

指定したフォルダ内(サブフォルダ含む)の全てのMP3ファイルの情報を抽出、

一旦セルに全て展開してみようと思います。

 合わせ技コード

早速ですが2つのネタを合わせて、多少の修正を加えたのが以下のコードです。

Dim MusicFileProperty() As Variant
Dim n As Long
Sub GetMusicFileProperty()
     n = 0
     'FileSearchで抽出したMP3ファイルのアドレスを蓄積するための配列
     ReDim MusicFileProperty(n)
     Dim StartTime As Double

’①
     'サブルーチンFileSearchで、指定したフォルダ内の全てのMP3ファイルを検索する
     FileSearch "G:\Music\"

     'FileSearchで取得したMP3ファイルのタグ情報をセルに転記する
     ReDim Preserve MusicFileProperty(UBound(MusicFileProperty) - 1)
     Range("A2").Resize(UBound(MusicFileProperty) + 1, 10).Value = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(MusicFileProperty))
End Sub
'-------------------------------------------------------------------------
Sub FileSearch(RootFolder As String)
     Dim myFSO As FileSystemObject
     Set myFSO = New FileSystemObject
          
     Dim myFolder  As Variant
     Dim MusicFile  As Variant
     
     'FileSystemObjectでファイルの検索・抽出を行う
     For Each MusicFile In myFSO.GetFolder(RootFolder).Files
          '拡張子がmp3のファイルのタグ情報を配列へ取り込む
          If LCase(myFSO.GetExtensionName(MusicFile)) = "mp3" Then
               MusicFileProperty(n) = Song_Property(myFSO.GetFile(MusicFile).Path)
               n = n + 1
               ReDim Preserve MusicFileProperty(n)
          End If
     Next

     '再帰処理でフォルダ内のフォルダの中身を検索
     For Each myFolder In myFSO.GetFolder(RootFolder).SubFolders
          FileSearch myFSO.GetFolder(myFolder).Path
     Next
     
     Set myFSO = Nothing
End Sub
'-------------------------------------------------------------------------
Function Song_Property(MusicFilePath As String) As Variant
     Dim FSO As FileSystemObject
     Dim objShell As Variant
     Dim objFolder As Variant
     Dim i As Long
     Dim n As Long
     Dim MusicFilePropertyColumn As Variant
     Dim Song As Variant
     Dim myArray(9) As Variant
     
     Set FSO = New FileSystemObject
     Set objShell = CreateObject("Shell.Application")
     Set objFolder = objShell.Namespace(FSO.GetFile(MusicFilePath).parentfolder & "\")
     Song = FSO.GetFile(MusicFilePath).Name
     
'②               
     MusicFilePropertyColumn = Array(14, 15, 16, 20, 21, 26, 27, 180, 195, 220)
     For i = 0 To 9
          myArray(i) = objFolder.getdetailsof(objFolder.parsename(Song), MusicFilePropertyColumn(i))
     Next i
     Song_Property = myArray
End Function

①各自の環境に合わせて音楽フォルダを指定してください。

②MP3タグのうち必要な項目を選択して、抽出したタグ情報を配列に格納。

1つの配列の中に1曲分の情報がまとまっていて、それをSong_Property関数の返り値としています。

上記のコードを新規ブックのモジュールにコピペして、Microsoft Scripting Runtime」 に参照設定を行えば、正常に動くと思います。

 まとめ

指定したフォルダ以下のMP3ファイルからタグ情報を抽出して、セルに展開することができました。

実際に実行してみると多少の問題はあるのですが、当初予定していた動作は出来ているのでこのまま進めていこうと思います。

次回はタグ情報をセルに展開するのではなく、SQLite3データベースに取り込んでみようと思います。

おまけ

多少の問題

・抽出処理にちょっと時間がかかりすぎている(16,000件で13分)

・タグ情報が抽出できていない曲がある

気になるのでそこは原因追求・ブラッシュアップしていきたい。

恐怖!計算式の答えが必ず0に!(循環参照の見つけ方

先日ある計算式を作ったんですよ。

f:id:ExcelLover:20180804113113j:plain
(※実際のややこしい表の一部抜粋のため数式もややこしい)

そしたらですね、数式はあってるのに(あってないけど)

答えが0しか表示されないんですよ。

どこがおかしいんだろうと思って、「数式の検証」で調べてみると

途中までは、よしよしちゃんと計算できていると、思っていたのに f:id:ExcelLover:20180804113140j:plain

一番最後で答えがになる! f:id:ExcelLover:20180804113226j:plain

why?

 循環参照の見つけ方

タイトルで出オチしてるんですが、循環参照が発生しているために答えが0になっているんですね。

循環参照とは

数式が入力されているセル自体を計算しようとし、かつ反復計算と呼ばれる機能がオフになっているために発生します

今回の例では(最初の画像で)B1セルの数式がB1セル自体を参照しているために循環参照が発生していました。

そもそも循環参照が発生したときにはこのような忠告が表示されます。 f:id:ExcelLover:20180804113314j:plain

この忠告は

・循環参照が1つもないで新しく循環参照が発生したとき

・対象のブックを開いたとき

にのみ表示されるようです。

既に循環参照が発生しているときに更に循環参照が発生する数式を作成しても忠告は表示されませんでした。

発生時の忠告以外にも自分で循環参照を確認する方法もあります。

ステータスバー

循環参照が発生しているときはステータスバーに「循環参照」の表示と、発生しているセルが1つだけ表示されます。

セル番地の表示は1つだけですの表示されている箇所を直してまだ循環参照が残っている場合は、セル番地の表示が変わります。
f:id:ExcelLover:20180804113340j:plain

エラーチェック

数式タブの「エラーチェック」からも同じように確認することができます。

こちらも同じように複数の循環参照があっても1つだけ表示されますので、表示が無くなるまで修正していきましょう。
f:id:ExcelLover:20180804113357j:plain

まとめ

最初に循環参照が発生したときにメッセージは表示されたんですが、その後で席を外して戻ってきてから、その事を忘れていて、ハマっていました。

数式の検証で調べているときに数式自体をよく見ていればすぐに気づいたんでしょうけど、1番最後までは想定通りの計算をしてくれていたので見逃していました。