Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


6315 / 13644 ツリー ←次へ | 前へ→

【45906】ファイル名で使用できない文字の排除 ボビー 07/1/17(水) 18:48 質問[未読]
【45913】Re:ファイル名で使用できない文字の排除 ぱっせんじゃー 07/1/17(水) 19:20 発言[未読]
【45930】Re:ファイル名で使用できない文字の排除 ボビー 07/1/18(木) 10:38 お礼[未読]
【45934】Re:ファイル名で使用できない文字の排除 ボビー 07/1/18(木) 11:48 質問[未読]
【45937】Re:ファイル名で使用できない文字の排除 Blue 07/1/18(木) 11:57 回答[未読]
【45946】Re:ファイル名で使用できない文字の排除 ボビー 07/1/18(木) 14:27 お礼[未読]
【45952】Re:ファイル名で使用できない文字の排除 Kein 07/1/18(木) 17:51 回答[未読]
【45953】Re:ファイル名で使用できない文字の排除 ichinose 07/1/18(木) 20:43 発言[未読]
【45957】Re:ファイル名で使用できない文字の排除 Blue 07/1/19(金) 9:50 発言[未読]
【45917】Re:ファイル名で使用できない文字の排除 Hirofumi 07/1/17(水) 20:07 回答[未読]
【45931】Re:ファイル名で使用できない文字の排除 ボビー 07/1/18(木) 10:42 お礼[未読]
【45958】Re:ファイル名で使用できない文字の排除 ボビー 07/1/19(金) 11:26 お礼[未読]

【45906】ファイル名で使用できない文字の排除
質問  ボビー  - 07/1/17(水) 18:48 -

引用なし
パスワード
   いつも参考にさせていただいています。

現在、以下のようなロジックで[UserForm1]で入力(TextBox1:strJuyoka)された項目をファイル名の一部として使用しているのですが、ファイル名として使用できない文字【\ ; : | * ? 】等が含まれた場合エラーとなってしまいます。
[UserForm1]のCommndButton1の処理で[TextBox1]に対し、使用できない文字が含まれているか否かのチェックをしたいのですが…

Dim strSaveChosa AS String
Dim strJuyoka  AS String

strSaveChosa = "C:\需要家調査\" & strJuyoka & ".xls"

ReSave:
ActiveWorkbook.SaveAs FileName:=strSaveChosa

If Err Then
  strSaveChosa = "C:\需要家調査\?????.xls"
  Err.Clear
  GoTo ReSave
End

宜しくご教授願います。

【45913】Re:ファイル名で使用できない文字の排除
発言  ぱっせんじゃー  - 07/1/17(水) 19:20 -

引用なし
パスワード
   正規表現でチェックする方法があるようですが、私は
正規表現をよく理解していないので、文字一つづつを
チェックしています。

※私は、全部を全角化する、という荒技も使いますが、
全くお勧めできません・・・。

【45917】Re:ファイル名で使用できない文字の排除
回答  Hirofumi  - 07/1/17(水) 20:07 -

引用なし
パスワード
   こんなので善いのかな?
TextBox1は、不正な文字を"_"に置き換えます
TextBox2は、不正な文字を反転表示し、警告を出します

Option Explicit

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

  With TextBox1
    If .Text <> "" Then
      .Text = NameLetter(.Text)
    End If
  End With
  
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

  Dim lngPos As Long
  
  With TextBox2
    If .Text <> "" Then
      lngPos = LetterCheck(.Text)
      If lngPos > 0 Then
        Cancel = True
        .SelStart = lngPos - 1
        .SelLength = 1
        MsgBox Mid(.Text, lngPos, 1) & "の文字が不正です", vbInformation
      End If
    End If
  End With
  
End Sub

Private Function NameLetter(ByVal strName As String) As String

'  ファイル名のチェック
  
  Dim i As Long
  Dim vntLetter As Variant
  Dim lngPos As Long
  
  'ファイル名として使用不可能な文字の一覧を作成
  vntLetter = Array(":", "\", "?", "[", "]", "/", "*")
  
  '一覧全てに就いて
  For i = 0 To UBound(vntLetter, 1)
    '引数の文字列に一覧の文字が含まれるか探索
    lngPos = InStr(1, strName, vntLetter(i), vbTextCompare)
    '引数の文字列に一覧の文字が無くなるまで繰り返し
    Do Until lngPos = 0
      '有る場合、"_"に置換
      strName = Left(strName, lngPos - 1) _
            & "_" & Mid(strName, lngPos + 1)
      '引数の文字列に一覧の文字が含まれるか探索
      lngPos = InStr(1, strName, vntLetter(i), vbTextCompare)
    Loop
  Next i
  
  '戻り値として、置換後の文字列を返す
  NameLetter = strName
  
End Function

Private Function LetterCheck(strName As String) As Long

  
  Dim i As Long
  Dim vntLetter As Variant
  Dim lngPos As Long
  
  'ファイル名として使用不可能な文字の一覧を作成
  vntLetter = Array(":", "\", "?", "[", "]", "/", "*")
  
  '一覧全てに就いて
  For i = 0 To UBound(vntLetter, 1)
    '引数の文字列に一覧の文字が含まれるか探索
    lngPos = InStr(1, strName, vntLetter(i), vbTextCompare)
    If lngPos > 0 Then
      Exit For
    End If
  Next i
  
  '戻り値として、不正文字の位置を返す
  LetterCheck = lngPos
  
End Function

【45930】Re:ファイル名で使用できない文字の排除
お礼  ボビー  - 07/1/18(木) 10:38 -

引用なし
パスワード
   ▼ぱっせんじゃー さん:
>正規表現でチェックする方法があるようですが、私は
>正規表現をよく理解していないので、文字一つづつを
>チェックしています。
>
>※私は、全部を全角化する、という荒技も使いますが、
>全くお勧めできません・・・。

ありがとうございます。
私の理解レベルでも正規表現とは???です。
[文字一つづつ]と[全角に]を試したいと思います。

【45931】Re:ファイル名で使用できない文字の排除
お礼  ボビー  - 07/1/18(木) 10:42 -

引用なし
パスワード
   ▼Hirofumi さん:
>こんなので善いのかな?
>TextBox1は、不正な文字を"_"に置き換えます
>TextBox2は、不正な文字を反転表示し、警告を出します

教えて頂いたロジックを参考に実行しました。
思った通りの処理になりましたが、私のVBA理解レベルではメンテナンス発生時に苦労しそうです。
もう少し理解・知識を深めたらこのロジックを使ってみたいと思います。
ありがとうございました。

>
>Option Explicit
>
>Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
>
>  With TextBox1
>    If .Text <> "" Then
>      .Text = NameLetter(.Text)
>    End If
>  End With
>  
>End Sub
>
>Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
>
>  Dim lngPos As Long
>  
>  With TextBox2
>    If .Text <> "" Then
>      lngPos = LetterCheck(.Text)
>      If lngPos > 0 Then
>        Cancel = True
>        .SelStart = lngPos - 1
>        .SelLength = 1
>        MsgBox Mid(.Text, lngPos, 1) & "の文字が不正です", vbInformation
>      End If
>    End If
>  End With
>  
>End Sub
>
>Private Function NameLetter(ByVal strName As String) As String
>
>'  ファイル名のチェック
>  
>  Dim i As Long
>  Dim vntLetter As Variant
>  Dim lngPos As Long
>  
>  'ファイル名として使用不可能な文字の一覧を作成
>  vntLetter = Array(":", "\", "?", "[", "]", "/", "*")
>  
>  '一覧全てに就いて
>  For i = 0 To UBound(vntLetter, 1)
>    '引数の文字列に一覧の文字が含まれるか探索
>    lngPos = InStr(1, strName, vntLetter(i), vbTextCompare)
>    '引数の文字列に一覧の文字が無くなるまで繰り返し
>    Do Until lngPos = 0
>      '有る場合、"_"に置換
>      strName = Left(strName, lngPos - 1) _
>            & "_" & Mid(strName, lngPos + 1)
>      '引数の文字列に一覧の文字が含まれるか探索
>      lngPos = InStr(1, strName, vntLetter(i), vbTextCompare)
>    Loop
>  Next i
>  
>  '戻り値として、置換後の文字列を返す
>  NameLetter = strName
>  
>End Function
>
>Private Function LetterCheck(strName As String) As Long
>
>  
>  Dim i As Long
>  Dim vntLetter As Variant
>  Dim lngPos As Long
>  
>  'ファイル名として使用不可能な文字の一覧を作成
>  vntLetter = Array(":", "\", "?", "[", "]", "/", "*")
>  
>  '一覧全てに就いて
>  For i = 0 To UBound(vntLetter, 1)
>    '引数の文字列に一覧の文字が含まれるか探索
>    lngPos = InStr(1, strName, vntLetter(i), vbTextCompare)
>    If lngPos > 0 Then
>      Exit For
>    End If
>  Next i
>  
>  '戻り値として、不正文字の位置を返す
>  LetterCheck = lngPos
>  
>End Function

【45934】Re:ファイル名で使用できない文字の排除
質問  ボビー  - 07/1/18(木) 11:48 -

引用なし
パスワード
   ▼ぱっせんじゃー さん:
>※私は、全部を全角化する、という荒技も使いますが、
>全くお勧めできません・・・。

全部全角にしようとしましたが、[\]のみ半角のままで変換されません…
どうしたら[\]→[¥]になるのでしょうか?

private Sub Test()
  Dim strZenkaku As String
  Dim strHankaku As String
  
  strHankaku = "ああああ"
  strHankaku = strHankaku & "/:,;\*?<>|[]" & Chr(34) & "いいい"
  strZenkaku = StrConv(strHankaku, vbWide)
  MsgBox "需要家名 = " & strZenkaku
End Sub

【45937】Re:ファイル名で使用できない文字の排除
回答  Blue  - 07/1/18(木) 11:57 -

引用なし
パスワード
   そういう仕様(バグ)らしいです。

\だけReplaceで置換するとか。

Replace("ABC\EFG", "\", "¥")

【45946】Re:ファイル名で使用できない文字の排除
お礼  ボビー  - 07/1/18(木) 14:27 -

引用なし
パスワード
   ▼Blue さん:
>そういう仕様(バグ)らしいです。
>
>\だけReplaceで置換するとか。
>
>Replace("ABC\EFG", "\", "¥")

勉強になりました。
ありがとうございます。

【45952】Re:ファイル名で使用できない文字の排除
回答  Kein  - 07/1/18(木) 17:51 -

引用なし
パスワード
   いちおう正規表現でチェックする方法なら、こんな感じになります。

Sub RegExp_Test()
  Dim strJuyoka As String
 
  strJuyoka = "My>data*test?"
  With CreateObject("VBScript.RegExp")
   .Pattern = "(\:|\\|\?|\[|\]|\/|\*)"
   .Global = True
   If .Test(strJuyoka) Then
     MsgBox "ファイル名として正しくない文字があります", 48
   Else
     MsgBox "OK !"
   End If
  End With
End Sub

チェックするだけなら以上のように Testプロパティ だけで出来ますが、
見つかった文字をどうしたいか、によって If 構文の中身を増加する
必要があります。具体的には Set Matches = .Excute(strJuyoka)
として見つかった文字を配列に入れ、ループして置換していきます。
残念ながら私は RegExpオブジェクトの Replaceメソッドを使いこなせないので
VBAの Replace関数を使って、以下のようなコードを作ってみました。
Patternプロパティに設定した文字列を、全て削除しています。

Sub RegExp_Test2()
  Dim strJuyoka As String, Newstr As String
  Dim Matches As Object, Match As Object
  Dim SCnt As Integer
 
  strJuyoka = "My*data?tes/t"
  With CreateObject("VBScript.RegExp")
   .Pattern = "\:|\\|\?|\[|\]|\*|\/"
   .Global = True
   If .Test(strJuyoka) Then
     MsgBox "ファイル名として正しくない文字があります", 48
     Set Matches = .Execute(strJuyoka)
     SCnt = Matches.Count
     For Each Match In Matches
      If SCnt = Matches.Count Then
        Newstr = Replace(strJuyoka, Match.Value, "")
        SCnt = SCnt - 1
      Else
        Newstr = Replace(Newstr, Match.Value, "")
      End If
     Next
     MsgBox Newstr: Set Matches = Nothing
   Else
     MsgBox "OK !"
   End If
  End With
End Sub

ただし「文字を削除するだけ」でいいなら、Replace関数で簡単に出来ます。
即ち・・

Sub Test_Replace()
  Dim strJuyoka As String
  Dim SAry As Variant
 
  strJuyoka = "My*?da?ta?tes/t"
  SAry = Array(":", "\", "?", "[", "]", "*", "/")
  For i = 0 To 6
   strJuyoka = Replace(strJuyoka, SAry(i), "")
  Next i
  MsgBox strJuyoka
End Sub

などとするだけです。

【45953】Re:ファイル名で使用できない文字の排除
発言  ichinose  - 07/1/18(木) 20:43 -

引用なし
パスワード
   こんばんは。
皆さん、こんばんは。

>全部全角にしようとしましたが、[\]のみ半角のままで変換されません…
>どうしたら[\]→[¥]になるのでしょうか?

へえ、そうなんですか!!これは、知りませんでした。
Strconvを半角・全角変換を目的で使ったことがあまりないので勉強になりました。

これは、メモメモ・・・。

>private Sub Test()
>  Dim strZenkaku As String
>  Dim strHankaku As String
>  
>  strHankaku = "ああああ"
>  strHankaku = strHankaku & "/:,;\*?<>|[]" & Chr(34) & "いいい"
>  strZenkaku = StrConv(strHankaku, vbWide)
>  MsgBox "需要家名 = " & strZenkaku
>End Sub

私は、ワークシート関数派?です。

Sub Test()
  Dim strZenkaku As String
  Dim strHankaku As String
 
  strHankaku = "ああああ"
  strHankaku = strHankaku & "/:,;\*?<>|[]" & Chr(34) & "いいい"
  strZenkaku = WorksheetFunction.Dbcs(strHankaku)
  MsgBox "需要家名 = " & strZenkaku
End Sub

これだと\----¥になりました。

【45957】Re:ファイル名で使用できない文字の排除
発言  Blue  - 07/1/19(金) 9:50 -

引用なし
パスワード
   ▼ichinose さん:
>>全部全角にしようとしましたが、[\]のみ半角のままで変換されません…
>>どうしたら[\]→[¥]になるのでしょうか?
>
>へえ、そうなんですか!!これは、知りませんでした。
>Strconvを半角・全角変換を目的で使ったことがあまりないので勉強になりました。
VB.NETですがMSのサポートのサイトにこんなの見つけました。
://support.microsoft.com/kb/916603/ja
(おそらくVB6も同じとみてよさそう)

ちなみに、StrConvはAPIのLCMapStringを呼んでいるようで、
LCMapStringでも、同様に\(バックスラッシュ)は全角に出来ませんでした。
(APIに代えれば出来るかと思ったけど、同じだった)


>WorksheetFunction.Dbcs
こんな方法があるんですね。勉強になります。

【45958】Re:ファイル名で使用できない文字の排除
お礼  ボビー  - 07/1/19(金) 11:26 -

引用なし
パスワード
   ▼ご教授頂いた皆さんへ

アウトプットは1つでも、方法は多種多様にあるのですね…
本当に勉強になります。
簡単ではありますが、目的としていたAPも出来上がり本日リリースしました。
皆様、どうもありがとうございました。

6315 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free