食っちゃ寝システムができるまで

「食っちゃ寝システム」ができるまでの、棚卸&備忘録です。

VBA使用頻度の高いコード(20):ファイル名を読み出すマクロ

f:id:taikobox:20181209173448p:plain

ファイル(フォルダ)名を読み出すマクロ

ファイル名をダイアログボックスを使って読み出すマクロ。単体で使うことは少ないですが他のマクロと組合わせて使うこと多いです。


===============================

’ファイル選択読み出してイメージに読込

Private Sub Exif_Path_Click()
Dim LoadFile As String
Dim GetFilePath As String
LoadFile = MsgBox("新規ファイル読込みます", vbYesNo)
If (LoadFile = vbNo) Then
Exit Sub
Else
ChDir ActiveWorkbook.Path
GetFilePath = Application.GetOpenFilename _
("jpg画像,*.jpg;*.jpeg", , "画像の選択", , False)
End If
ExifModify.Exif_Path = GetFilePath
ExifModify.Exif_Image.Picture = LoadPicture(GetFilePath)
Call GetExifinfo
End Sub

===============================

 

Private Sub Folder_1_Click()

’フォルダ選択読み出してその中のJPGファイルをリストに取り持む
Dim LoadFile As String
Dim GetFilePath As String
Dim pkupFolder
LoadFile = MsgBox("新規フォルダ読込みます", vbOKCancel)
If (LoadFile = vbNo) Then
Exit Sub
Else
ckFolder.FileList.Clear
ChDir ActiveWorkbook.Path
'フォルダ名取込み
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
pkupFolder = .SelectedItems(1)
End If
End With
End If
ckFolder.Folder_1 = pkupFolder
If Dir(ckFolder.Folder_1, vbDirectory) = "" Then
MsgBox "フォルダがありません"
ckFolder.Folder_1 = ""
ElseIf Dir(ckFolder.Folder_1 & "\*.Jpg", vbDirectory) = "" Then
MsgBox "ファイルがありません"
ckFolder.Folder_1 = ""
Else
With ckFolder.FileList
pkupJpegFile = Dir(ckFolder.Folder_1 & "\*.Jpg")
Do While pkupJpegFile <> ""
ctFile = ctFile + 1
.AddItem pkupJpegFile
pkupJpegFile = Dir()
Loop
End With

ckFolder.ctFile_1 = ""
ckFolder.ctFile_2 = ""
ckFolder.ctFile_3 = ctFile
End If

End Sub

 

===============================