[[20170522134013]] 『ファイル名に機種依存文字が含まれる場合』(天国耳) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『ファイル名に機種依存文字が含まれる場合』(天国耳)

こんにちは、よろしくお願いいたします。
下記のHPの記述を参考に、テキストファイルの文字コードを取得するFunctionを書いてみました。

VBAで、テキストファイルの文字コードを自動判定します。
http://scripting.cocolog-nifty.com/blog/2007/02/vba_937b.html

テストでデスクトップ上にあるテキストファイルを対象にしています。一応はうまくいっているのですが、
ファイル名が「♡ ファイル名」のように機種依存文字?が含まれている場合はエラーになります。
このFunctionの場合「不明」を返します。

ファイル名は、OutLookで受信したメールアイテムをOutLook VBAでテキストファイルとして保存している
もので、メールアイテムのSubjectがそのままテキストファイル名となっています。

ファイル名に機種依存文字が含まれていても処理が出来るようにするにはどのようにすればいいでしょうか?
ご教示お願いいたします。

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub test()

    Dim myPath As String
    Dim mycharset As String
    Dim pathitiran As String
    Dim myfol As String
    Dim mycnt As Integer
        myfol = CreateObject("WScript.Shell").SpecialFolders("Desktop")
        pathitiran = Dir(myfol & "\*.txt") 'デスクトップ上のテキストファイル
        mycnt = 0
        Do While pathitiran <> ""
            mycnt = mycnt + 1
            myPath = myfol & "\" & pathitiran
            mycharset = CharSetOfText(myPath) 'Functionにパスを渡して文字コード取得
            Cells(mycnt, 1).Value = myPath
            Cells(mycnt, 2).Value = mycharset
            pathitiran = Dir()
        Loop
End Sub

Function CharSetOfText(ByVal myPath As String)

    Dim fso As Object
    Dim objFile As Object
    Dim htmlfile As Object
        Err.Clear
        On Error GoTo er 'エラーの場合、erにジャンプ
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set objFile = fso.GetFile(myPath)
        Set htmlfile = GetObject(myPath, "htmlfile")
        Do While htmlfile.readyState <> "complete"
            Sleep 100
            DoEvents
        Loop
        CharSetOfText = htmlfile.Charset
        Set objFile = Nothing
        Set htmlfile = Nothing
        Set fso = Nothing
        On Error GoTo 0
        Exit Function
er: 'エラーの場合
        CharSetOfText = "不明"
End Function

< 使用 Excel:Excel2007、使用 OS:WindowsVista >


最近のwindowsならば、内部的にはutf-8なので、ファイル名がutf-8でも添付ファイルを保存できたりします。が、リネームしようとすると、不正文字があるとか出てきて、そのままだと保存できないという、中途半端な状態になっています。

vistaは、ん〜、忘れました。 とにかく、問題の起きるファイル名を1文字ずつ文字コードチェックし、別の文字に変換するよう対応するしか無いかも知れません。

または、OutLook側の設定で、日本語をJIS形式にすることで、対応できたりしないでしょうか?

なお、On Error Goto の使い方が間違っています。こんな書き方をする人は、On Error 命令を使ってはいけません。トラブルの元ですよ。
(???) 2017/05/22(月) 16:07


 ???さん、ご回答ありがとうございます。

下記のページの回答を参考にFunctionを作ってみました。
文字列からファイル名に使えない文字を削除して返すものです。

https://oshiete.goo.ne.jp/qa/8996251.html

Function UNICODEDEL(ByVal txt As String) As String

	Dim i As Integer
	Dim c As String
	Dim newstr As String
	Dim chkuni As Boolean
		newstr = ""
		For i = 1 To Len(txt)
			chkuni = True
			c = Mid$(txt, i, 1)
			If Asc(c) = 63 Then
				If "?" <> txt Then
					chkuni = False
				End If
			ElseIf AscW(c) > -8193 And AscW(c) < -5887 Then
				chkuni = False
			Else

			End If
			If chkuni = True Then newstr = newstr & c
		Next i
		UNICODEDEL = newstr
End Function

なお、On Error Goto の使い方が間違っています

勉強してみます。ありがとうございました。
(天国耳) 2017/05/23(火) 16:34


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.