aviファイルなどをwmvファイルなどに変換しましょう。
WindowsMwdiaplayerエンコーダでファイル変換が可能です。
http://www.microsoft.com/japan/windows/windowsmedia/download/encode.aspx
ちょっといじってみたのですが、複数ファイルの一括変換の操作が困難でした。
そこで、なにか方法はないものかと探していたらＳＤＫを見つけました。
ＳＤＫを使うとエンコーダをオブジェクトとして使用できるようになります。
まず、マイクロソフトのサイトからエンコーダとSDKをダウンロードしてください。
http://msdn2.microsoft.com/ja-jp/windowsmedia/bb190309(en-us).aspx
※リンクは2007年に貼り直しました。この記事を書いたときはWindows Media Encoder 9 Series SDKを使用していますが、最新バージョンのダウンロードをおすすめすます。
前準備
ＳＤＫをダウンロードしたら、参照設定を行います。
エクセルVBAのツール（T)→参照設定（R)を選択してください。
参照設定ボックスがポップアップしたら、WindowsMediaEncoderをオンにしてください。
以上で準備ＯＫです。
サンプルマクロです。
Sub エンコード()
' まずエンコーダ（IWMEncoderオブジェクト）を作成します。
' これはブジェクトというよりむしろ”エンコード作業”という感じです。
' ヘルプファイルではセッションという概念で説明しています。
Dim Encoder As WMEncoder
Set Encoder = New WMEncoder
' 次にエンコードする対象を指定します。
' 具体的にはIWMEncoderオブジェクトの配下に、SourceGroupコレクションを作成します。
Dim SrcGrpColl As IWMEncSourceGroupCollection
Set SrcGrpColl = Encoder.SourceGroupCollection
' SourceGroupコレクションは単数または複数のSourceGroupオブジェクトを含めることができます。
' IWMEncSourceGroup2というオブジェクトですが、
' これは設定内容を更新できるSourceGroupオブジェクトのことです。
Dim SrcGrp As IWMEncSourceGroup2
Set SrcGrp = SrcGrpColl.Add("SG_1")
' SourceGroupオブジェクトには、
' 音源（IWMEncAudioSourceオブジェクト）や、
' 映像（IWMEncVideoSourceオブジェクト）などを指定することができます。
Dim SrcVid As IWMEncVideoSource2
Dim SrcAud As IWMEncAudioSource
Set SrcVid = SrcGrp.AddSource(WMENC_VIDEO)
Set SrcAud = SrcGrp.AddSource(WMENC_AUDIO)
' 一度にエンコードできるのはひとつのSourceGroupオブジェクトだけです。
' エンコード元にファイルを指定する場合は、wma, .wmv, .asf, .avi, .wav, .mp3, .mpg, .bmp, and .jpgが
' 指定できますがものによってはデコーダが必要です。
' 今回は音源・映像ともaviファイルを指定します。
SrcVid.SetInput "D:¥video¥test.avi"
SrcAud.SetInput "D:¥video¥test.avi"
' エンコーダ（というかシステム）は複数のProfileを保有していますが、これをProfileコレクションと呼びます。
' Profileは名前がついていて、その名前で指定します。例を挙げるとこんなやつです。
' Windows Media Video 8 for Local Area Network (384 Kbps)
' Windows Media Video 8 for Broadband (NTSC, 1400 Kbps)
Dim ProColl As IWMEncProfileCollection
Dim Pro As IWMEncProfile
Dim i As Integer
Dim lLength As Long
Set ProColl = Encoder.ProfileCollection
lLength = ProColl.Count
' Profileはあとで編集しますので、とりあえず、適当に選んでおきます
' SourceGroupにはひとつのProfileを適用することができます。
' もちろんこのProfileの通りエンコードします。
For i = 0 To lLength - 1
Set Pro = ProColl.Item(i)
If Pro.Name = "Windows Media Video 8 for Broadband (NTSC, 700 Kbps)" Then
SrcGrp.Profile = Pro
Exit For
End If
Next i
' Profile編集用にWMEncProfile2オブジェクトを作成し、上記プロファイルの内容をコピーします
Dim Pro2 As WMEncProfile2
Set Pro2 = New WMEncProfile2
Pro2.LoadFromIWMProfile Pro
'ビデオ系のコンテンツか否か確認しています
If Pro2.ContentType <> 16 And Pro2.ContentType <> 17 And _
Pro2.ContentType <> 272 And Pro2.ContentType <> 273 Then Exit Sub
' 固定ビットレートを選択します
Pro2.VBRMode(WMENC_VIDEO, 0) = WMENC_PVM_NONE
'コーデックの列挙
' For i = 0 To Pro2.VideoCodecCount - 1
' Dim lVid4cc As Long, vVidCodecName As Variant
' lVid4cc = Pro2.EnumVideoCodec(i, vVidCodecName)
' Debug.Print i & " " & vVidCodecName
'Next i
'オーディオ列挙
'For i = 0 To Pro2.AudioCodecCount - 1
' Dim lAud4cc As Long, vAudCodecName As Variant
' lAud4cc = Pro2.EnumAudioCodec(i, vAudCodecName)
' Debug.Print i & " " & vAudCodecName
' Dim ii As Integer
' For ii = 0 To Pro2.AudioFormatCount(i) - 1
' Dim lAudVal1 As Long, vAudFormatName As Variant, lAudioBitrate As Long
' Dim vChannels As Variant, vSRate As Variant, vBitSample As Variant
' lAudVal1 = Pro2.EnumAudioFormat(i, ii, _
' vAudFormatName, vSRate, vChannels, vBitSample) '
' Debug.Print i & "-" & ii & " " & vAudFormatName
' Next ii
' Next i
' Profileの核心ともいうべきAudienceオブジェクトに
' コーデック、ビットレート、フレーム数、画面サイズなどを指定します。
Dim Audnc As IWMEncAudienceObj
For i = 0 To Pro2.AudienceCount - 1
Set Audnc = Pro2.Audience(i)
lAudioBitrate = Audnc.AudioBitrate(0)
Audnc.VideoBitrate(0) = 750000
Audnc.VideoFPS(0) = 30000
Audnc.VideoImageSharpness(0) = 80
Audnc.VideoCodec(0) = 6 'Windows Media Video 9
Audnc.VideoHeight(0) = 0 '0は入力と同じ大きさ
Audnc.VideoWidth(0) = 0 '0は入力と同じ大きさ
Next i
' 編集したProfileに置き換えます
SrcGrp.Profile = Pro2
' 著作、タイトル等の情報を追加します
Dim Descr As IWMEncDisplayInfo
Set Descr = Encoder.DisplayInfo
Descr.Author = "Xillion"
Descr.Copyright = "Copyright http://www.xillion.net/"
Descr.Description = ""
Descr.Rating = ""
Descr.Title = "Sample"
' 既定のディスクリプション以外にも情報を追加できます
' Attributeオブジェクトは名前と内容を登録できます
Dim Attr As IWMEncAttributes
Set Attr = Encoder.Attributes
Attr.Add "Created", "2005/08/30"
Attr.Add "Codec", "Windows Media Video 9"
' 保存先を指定します。
Dim File As IWMEncFile
Set File = Encoder.File
File.LocalFileName = "C:¥OutputFile.wmv"
' エンコード開始
Encoder.Start
' マクロが終了してしまうとエンコードが終わってしまうので
' エンコードが終了するまで待機します
Do Until Encoder.RunState = 5
DoEvents
Loop
MsgBox ("Finished!")
End Sub
これをちょっとかえて連続エンコードを行うようにしました。
A列にパス名、B列にファイル名が１行目からあるシートを想定しています。
Sub 連続エンコード()
Dim Encoder As WMEncoder
Dim SrcGrpColl As IWMEncSourceGroupCollection
Dim SrcGrp As IWMEncSourceGroup2
Dim SrcVid As IWMEncVideoSource2
Dim SrcAud As IWMEncAudioSource
Dim ProColl As IWMEncProfileCollection
Dim Pro As IWMEncProfile
Dim i As Integer
Dim lLength As Long
Dim Pro2 As WMEncProfile2
Dim Audnc As IWMEncAudienceObj
Dim Descr As IWMEncDisplayInfo
Dim Attr As IWMEncAttributes
Dim File As IWMEncFile
Dim yy As Integer
Set Encoder = New WMEncoder
Set SrcGrpColl = Encoder.SourceGroupCollection
Set SrcGrp = SrcGrpColl.Add("SG_1")
Set SrcVid = SrcGrp.AddSource(WMENC_VIDEO)
Set SrcAud = SrcGrp.AddSource(WMENC_AUDIO)
Set ProColl = Encoder.ProfileCollection
lLength = ProColl.Count
For i = 0 To lLength - 1
Set Pro = ProColl.Item(i)
If Pro.Name = "Windows Media Video 8 for Broadband (NTSC, 700 Kbps)" Then
SrcGrp.Profile = Pro
Exit For
End If
Next i
Set Pro2 = New WMEncProfile2
Pro2.LoadFromIWMProfile Pro
If Pro2.ContentType <> 16 And Pro2.ContentType <> 17 And _
Pro2.ContentType <> 272 And Pro2.ContentType <> 273 Then Exit Sub
Pro2.VBRMode(WMENC_VIDEO, 0) = WMENC_PVM_NONE
For i = 0 To Pro2.AudienceCount - 1
Set Audnc = Pro2.Audience(i)
Audnc.VideoBitrate(0) = 600000
Audnc.VideoFPS(0) = 30000
Audnc.VideoImageSharpness(0) = 80
Audnc.VideoCodec(0) = 6
Audnc.VideoHeight(0) = 0
Audnc.VideoWidth(0) = 0
Next i
SrcGrp.Profile = Pro2
Set Descr = Encoder.DisplayInfo
Descr.Author = "Xillion"
Descr.copyright = "Copyright http://www.xillion.net"
Descr.Description = ""
Descr.Rating = ""
Descr.Title = ""
Set Attr = Encoder.Attributes
Attr.Add "Created", Format(Now())
Attr.Add "Codec", "Windows Media Video 9"
Set File = Encoder.File
Application.DisplayStatusBar = True
Debug.Print
yy = 1
Do While Cells(yy, 1) <> ""
SrcVid.SetInput Cells(yy, 1) & Cells(yy, 2)
SrcAud.SetInput Cells(yy, 1) & Cells(yy, 2)
File.LocalFileName = "C:¥" & Left(Cells(yy, 2), Len(Cells(yy, 2)) - 4) & ".wmv"
Encoder.Start
Debug.Print Now() & " " & Str(yy)
Do Until Encoder.RunState = 5
Application.StatusBar = "Now Encoding - " & File.LocalFileName
DoEvents
Loop
yy = yy + 1
Loop
MsgBox ("Finished!")
Debug.Print Now & " finish"
Application.StatusBar = ""
End Sub
プロファイルマネージャです。ＳＤＫのサンプルコードですがとても便利なツールです。プロファイルの作成・編集が簡単にできます。
Sub ProfileManager()
' プロファイルマネージャ
Dim ProfileMgr As WMEncProfileManager
Dim sLastProfile As String
Dim sProfileDirectory As String
Dim sDetailsString As String
Set ProfileMgr = New WMEncProfileManager
ProfileMgr.WMEncProfileListEx WMENC_FILTER_AV, WMENC_FILTER_A, 0
ProfileMgr.WMEncProfileEdit "Windows Media Video 8 for Local Area Network (384 Kbps)", WMENC_FILTER_AV, 0
sDetailsString = ProfileMgr.GetDetailsString("Windows Media Video 8 for Local Area Network (384 Kbps)", 0)
sLastProfile = ProfileMgr.LastCreatedProfile
sProfileDirectory = ProfileMgr.ProfileDirectory
End Sub
関連記事：動画を再生する