[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ファイル名に機種依存文字が含まれる場合』(天国耳)
こんにちは、よろしくお願いいたします。
下記の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 >
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.