2014年10月1日

【個人用】ファイルの読み込みをするだけのVBAクラスモジュール

現場変わってモジュール作り直しての行程がめんd作業効率が悪いので、とりあえずこんな感じで。って感じで適当に作っておくだけ。

最近まともなマクロ作ってないのに2時間程度の突貫工事なので、出来は良くないけど、まぁ個人的なものだからいいか。と。



'「参照設定」→「Microsoft Scripting Runtime」にチェックを入れる。

Private ThisName As String
Private ThisPath As String
Private ThisFile As File

'ファイル名の設定
'フルパス指定されたらファイル名だけ入れる
Public Property Let Name(ByVal Filename As String)
    ThisName = Dir(Filename, vbNormal)
End Property

Public Property Get Name() As String
    Name = ThisName
End Property

'ファイルパスの設定
'ファイル名ごと指定されたらパスだけ入れる。
Public Property Let Path(ByVal FilePath As String)
    If Dir(FilePath, vbDirectory) = "" Then
        ThisPath = ""
        ThisPath = ""
    Else
        pos = InStrRev(FilePath, "\")
        ThisPath = Left(FilePath, pos)
    End If
End Property

Public Property Get Path() As String
    Path = ThisPath
End Property

'ファイル名とパスを設定するだけのメソッド。
'Nameプロパティの値を返す。
Public Function SetFileName(ByVal Filename As String) As String
    Me.Name = Filename
    Me.Path = Filename
    SetFileName = Me.Name
End Function

'ファイルを開く
'引数にファイルパスを指定しなかった場合はダイアログボックスを表示させる。
'開けた場合はファイル名を返す、開けなかったら空白を返す。
Public Function OpenFile(Optional ByVal Filename As String) As String
    Dim fso As New FileSystemObject
    If Filename <> "" Then
        SetFileName Filename
    Else
        Filename = Application.GetOpenFilename("すべてのファイル,*.*")
        If VarType(Filename) = vbBoolean Then
            OpenFile = ""
            Exit Function
        Else
            SetFileName Filename
        End If
    End If
   
    If CheckFile = False Then
        OpenFile = ""
        Exit Function
    End If
   
    Set ThisFile = fso.GetFile(Filename)
    If IsNull(ThisFile) Then
        OpenFile = ""
    Else
        OpenFile = Me.Name
    End If
   
End Function

'プロパティに設定したPathとNameが正しいかの確認
'ファイルが存在する:True、存在しない:False
Private Function CheckFile() As Boolean
    Dim FullPath As String
    FullPath = Me.Path & Me.Name
    If FullPath = "" Then
        CheckFile = False
    ElseIf Dir(FullPath, vbNormal) = "" Then
        CheckFile = False
    Else
        CheckFile = True
    End If
End Function

0 件のコメント:

コメントを投稿