Excel VBAのあれこれ

久しぶりにExcelでVBAを組んでみると、いろいろ忘れすぎててびっくりしたのでメモっておく。


'' ======================================
'' 既存のシートをコピーして新規ブックで保存
'' ======================================

Dim objNewBook As Workbook

' 新規ブックを作成
Set objNewBook = Workbooks.Add

' 既存のワークシートを新規ブックへコピー
Worksheets("テンプレ").Copy Before:= objNewBook.Worksheets("新規シート名")

' 新規ブックを保存
objNewBook.SaveAs "C:\テンプレから作成.xls"

objNewBook.close
Set objNewBook = Nothing



'' ======================================
'' ファイル選択ダイアログ
'' ======================================
Dim strFileFilter As String     ' 選択ダイアログのファイルフィルター
Dim strPath As String           ' 選択されているファイルのパス

' 選択できる拡張子はCSVと全てのファイル
strFileFilter = "CSVファイル(*.csv),*.csv" & _
                "Excelファイル(*.xls),*.xls" & _
                ",すべてのファイル(*.*),*.*"

' ダイアログの初期ディレクトリにカレントディレクトリをセット
ChDir (CurDir)

' ファイル選択ダイアログを開く
strPath = Application.GetOpenFilename(strFileFilter)

If strPath = "False" Then
    MgsBox "キャンセルされました。"
Else
    MgsBox "選択したファイルのパス：" & strPath   
End If


'' ======================================
'' フォルダ選択ダイアログ
'' ======================================
 Dim objFolderDlg As Office.FileDialog   ' ダイアログオブジェクト

'  ダイアログオブジェクトの取得
Set objFolderDlg = Application.FileDialog(msoFileDialogFolderPicker)

' ダイアログの初期値をセット
objFolderDlg.InitialFileName = "C:\temp"

If objFolderDlg.Show() = True Then
    MgsBox "キャンセルされました。"
Else
    MgsBox "選択したフォルダのパス：" & objFolderDlg.SelectedItems(1) 
End If

'' ======================================
'' 数値チェック関数
'' ======================================
Private Function IsNumber(ByVal p_strValue As String) As Boolean
    Dim bolResult As Boolean
    Dim i As Integer
   
    bolResult = True

    If Len(p_strValue) = 0 Then
        bolResult = False
    Else
        For i = 1 To Len(p_strValue)
            If Not Mid(p_strValue, i, 1) Like "[0-9]" Then
                bolResult = False
                Exit For
            End If
        Next
    End If

    IsNumber = bolResult
End Function

'' ======================================
'' 画面の自動更新、自動計算の停止・再開
'' ======================================
' 画面の更新停止
Application.ScreenUpdating = False

' 自動計算停止
Application.Calculation = xlManual

' 自動計算実行
Calculate

' 自動計算再開
Application.Calculation = xlAutomatic

' 画面の更新再開
Application.ScreenUpdating = True

UTF-8のBOMを削除する

AccessでUTF-8のファイルをインポートしようとしたとき、

ビューで先頭に「・ｿ」と表示された謎の文字がついていて、正しくインポートできなかった。

どうもこれはBOMらしい。

バイナリエディタで削除はできるけど、自動で削除する方法を２つほど見つけたのでメモ。

■Excel VBAで削除

コードを書く前に参照設定で「Microsoft ActiveX Data Objects ～」を有効にすること。

BOMは先頭３バイトに着いてくる。

ならば４バイト目から先を出力しなおせばいいんだという手法。

ただし、ファイルが大きすぎるとメモリに入りきらないためエラー落ちする。

２８０MBまではちゃんと動いた、６６０MBではだめでした。

==================================================================

Dim readStream As ADODB.Stream

Dim writeStream As ADODB.Stream

Dim readFile As String

Dim writeFile As String

readFile = "C:\BOM付きファイル.txt"

writeFile = "C:\BOM無しファイル.txt"

' 4バイト目から読み込む

Set readStream = CreateObject("ADODB.Stream")

readStream.Open

readStream.Type = adTypeBinary

readStream.LoadFromFile (readFile)

readStream.Position = 3

' 出力ファイルをオープン

Set writeStream = CreateObject("ADODB.Stream")

writeStream.Open

writeStream.Type = adTypeBinary

' 読み込んだデータをそのままファイルに出力する（4バイト目以降を出力）

writeStream.Write (readStream.Read(adReadAll))

writeStream.SaveToFile writeFile, adSaveCreateOverWrite

' ファイルをクローズ

writeStream.Close

Set writeStream = Nothing

readStream.Close

Set readStream = Nothing
==================================================================

■バッチで削除 

これはよくわからないが、たしかに削除できる。

ただし、Unicodeで保存されてしまう。

そのうち理解できたら役に立つかも。
 

cmd /u /c type BOMありUnicodeファイル > BOMなしUnicodeファイル