常不軽のブログ（アサブロ）

フォルダの有無を確認して存在しない場合は多重層のフォルダ作成する
業務用のシステムを作るようになると、一般に紹介されている関数の「使えなさ」に苛立つ事がしばしばあります。
その中でフォルダの作成用の関数「MkDir」は私にとっては代表格です。
どうしてそう思うのか？
多重層のフォルダを作成できないからです。
多重層とは、例えばCドライブの下に「123」というフォルダを作って、さらにその下に「456」というフォルダを作成する事です。
「MkDir」Cドライブの下に「123」というフォルダしか作れないのです！

以下に提示した例は、「FSO_PH_Check」でフォルダの有無を確認して、存在しない場合、多重層でもフォルダを作成してくれるロジックです。
↓
'MkFolderで多重層のフォルダ作成に使います（宣言セクションに記述します!）。
Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" ( _
ByVal hwnd As Long, _
ByVal pszPath As String, _
ByVal psa As Long) As Long
’ここからは標準モジュールに記述します。
Function FSO_PH_Check(Folder_CK As String) As Boolean
'フォルダー有無のチェック
'FSOを利用するので、「MicroSoft Scripting Runtime」の参照設定が必須！

Dim cFso As FileSystemObject 'オブジェクト変数宣言

Set cFso = New FileSystemObject '変数にオブジェクトの代入

If cFso.FolderExists(Folder_CK) Then
FSO_PH_Check = True 'フォルダー有り
Else
FSO_PH_Check = False 'フォルダー無し
End If
End Function
'
Function MkFolder(FL As String) As Boolean
'フォルダの存在確認
If FSO_PH_Check(FL) = True Then
MkFolder = True
Else
If (MsgBox("フォルダ「" & FL & "」が存在しません！作成しますか？？", 4) = 7) Then
MkFolder = True
Exit Function
Else
'多重層のフォルダ作成
Dim rc As Long
Dim Target As String
Target = FL
rc = SHCreateDirectoryEx(0&, Target, 0&)
If rc = 0 Then
'正常終了
MkFolder = True
Else
'異常終了
MkFolder = False
End If
End If
End If
End Function
↑
業務ツールを作成する場合、関数「MkDir」は大抵の場合、役に立ちません。
多重層のフォルダを作成する事は、お仕事で利用する場合、必須ですからね！

「ODBC　DNS エントリの作成」

MySQLにマイクロソフトのOffice製品で接続する場合、ODBC接続を使います。
以下、PDFにMySQLのODBC接続ドライバをインストール後の「ODBC　DNS エントリの作成」手順を記載します。
開発事例

ExcelでMySQLサーバーへ接続

マイクロソフトのOffice製品でMySQLに接続するには、
1.MySQL用のODBC接続ドライバをインストールする。
2.「ODBCデータソースアドミニストレータ」でDNSを作成・設定する。
3.VBAでODBC接続のプログラムを作成する。


Sub MySQL接続()
On Error GoTo errHandler
Dim myCon As New ADODB.Connection 'Connectionオブジェクト

'接続文字列を設定する
myCon.ConnectionString = "Driver={MySQL ODBC 5.1 Driver};" _
& "Server=localhost; Database=kokyaku_kanri; Uid=root; Pwd=1234"'MySQLのIDとパスワード
'Server=localhost;はサーバーの名前、またはIPアドレスを記述。ここでは自分自身を指定している。
'データベースに接続する
myCon.Open
MsgBox "接続しました。"
'※ここにデータベースの処理を記述します。
'接続を切断する
myCon.Close
MsgBox "切断しました。"

procContinue:
Set myCon = Nothing
Exit Sub

errHandler:
'エラーが発生した場合にエラーメッセージを表示する
MsgBox Err.Description
Resume procContinue
End Sub

以上でExcelでMySQLサーバーへ接続が可能になります。
開発事例