ここから本文です

Microsoft Access 2016 のVBA初心者ですが、教えてください。

suu********さん

2019/7/1817:05:49

Microsoft Access 2016 のVBA初心者ですが、教えてください。

入庫データ変換Accessを改修しており、入庫データ取込時にボタンをクリックすると、任意のファイル取込する記述があり、取込ファイル名の先頭2桁が、SL と FL というファイル名が存在していて、間違えて SL を選択したつもりが、FL を選択してしまった場合にエラーメッセージを表示し、処理を中止したいのですがどのように記述したらよいでしょうか。
因みに、下記記述は前任者が考えたものです。



Option Compare Database
Option Explicit

'****************************************************
'ActiveXDataObjects(ADO)関連共通モジュール定数
'****************************************************

Public adoCon As ADODB.Connection
Public adoConExcel As ADODB.Connection
Public Const ADO_TIMEOUT = 60

'****************************************************
'システム共通モジュール定数
'****************************************************

Public Const C_AP_NAME = "アプリケーション名称"

'****************************************************
'*IN :ADOコネクションオブジェクト(adoMyMdb)
'*OUT :
'*処理内容:カレントMDBとの接続を行う
'****************************************************
Public Sub AdoOpen_MyMdb(ByRef adoMyMdb As ADODB.Connection)
On Error GoTo Err_AdoOpen_MyMdb

If adoMyMdb Is Nothing Then
'データベースオープン
Set adoMyMdb = New ADODB.Connection
adoMyMdb.ConnectionTimeout = ADO_TIMEOUT
Set adoMyMdb = Application.CurrentProject.Connection
End If

Exit Sub

Err_AdoOpen_MyMdb:
Call System_Error("AdoOpen_MyMdb")
End Sub

'****************************************************
'*IN :ADOコネクションオブジェクト(adoCon)
'*OUT :
'*処理内容:ADO接続を終了する
'****************************************************
Public Sub AdoClose(ByRef adoCon As ADODB.Connection)
On Error GoTo Err_AdoClose

If Not adoCon Is Nothing Then
'データベースクローズ
adoCon.Close
Set adoCon = Nothing
End If

Exit Sub

Err_AdoClose:
Call System_Error("AdoClose")
End Sub

'****************************************************
'*IN :
'*OUT :
'*処理内容:システムエラーメッセージを表示する
'****************************************************
Public Sub System_Error(ByVal strFncName As String)
On Error GoTo Err_AdoOpen_MyMdb

'システムエラーメッセージ表示
MsgBox "エラー番号[" & Err.Number & "]" & vbCrLf & _
"エラー内容[" & Err.Description & "]" & vbCrLf & _
"処理名称[" & strFncName & "]", vbCritical, C_AP_NAME

End Sub

'****************************************************
'*IN :ディレクトリパス(strDirPathDb)
'*OUT :選択したファイルのフルパス(GetFileName)
'*処理内容:ファイルを開くダイアログを表示する
'****************************************************
Public Function GetFileName(ByVal strDirPathDb As String) As String

Dim intRet As Integer

With Application.FileDialog(msoFileDialogOpen)

'ダイアログのタイトルを設定
.Title = "ファイルを開くダイアログの例"

'ファイルの種類を設定
.Filters.Clear
.Filters.Add "CSVファイル", "*.CSV"

'ファイルの種類の初期値を設定
.FilterIndex = 1

'複数ファイル選択を許可しない
.AllowMultiSelect = False

'初期パスを設定
'.InitialFileName = CurrentProject.Path
.InitialFileName = strDirPathDb

'ダイアログを表示
intRet = .Show
If intRet <> 0 Then

'ファイルが選択されたとき
'そのフルバスを返り値に設定
GetFileName = Trim(.SelectedItems.Item(1))
Else

'ファイルが選択されなければ長さゼロの文字列を返す
GetFileName
End If
End With

End Function
'****************************************************
'*IN :ファイルパス(strFilePath)
'*OUT :ディレクトリパス(GetDirPath)
'*処理内容:ディレクトリパスを返却する
'****************************************************
Public Function GetDirPath(ByVal strFilePath As String) As String

Dim strFileName As String

'ファイル名を取得
strFileName = Dir(strFilePath)

'ディレクトリパスを取得(フルパスからファイル名をカットする)
GetDirPath = Replace(strFilePath, strFileName, "")

End Function

閲覧数:
14
回答数:
1
お礼:
50枚

違反報告

ベストアンサーに選ばれた回答

pro********さん

2019/7/1817:23:32

GetFileName = Trim(.SelectedItems.Item(1))
の行を次のようにします。

If Left(Mid(.SelectedItems.Item(1), InStrRev(.SelectedItems.Item(1), "\") + 1), 2) = "SL" Then
MsgBox "ファイルの選択が誤っています。", vbOkOnly
GetFileName = ""
Else
GetFileName = Trim(.SelectedItems.Item(1))
Endif

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2019/7/19 09:12:53

ボタンクリックの記述のあとに、アドバイスいただいた記述をしたらできました。有難うございました。大変助かりました。これで開発完了でこれからテストをしてみたいと思います。

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる