みなさんこんにちは^^

ちょっと困っています。
VB6でコーディングを行っていますが
取得したファイル名称を一旦ワークに落として
それを出力ファイル名に利用したいのですが、
拡張子が邪魔をして上手く行きません。
何か拡張子を取るような方法があれば教えて頂きたいのですが!

例)入力ファイル名称 → 変換 → 出力ファイル名称
  AAA.TXT AAA_001.TXT
BBB_001.TXT BBB_001.TXT

このQ&Aに関連する最新のQ&A

A 回答 (4件)

FileSystemObjectを使ったらどうですか?



拡張子&ファイル名を取得する方法を書いときます
参照設定で「Microsoft Scripting Runtime」を参照します。
'拡張子のみ取得
Function hoge1(strPath As String) As String
Dim fso As New FileSystemObject
hoge1=fso.GetExtensionName(strPath)
End Sub

'ファイル名のみ取得
Function hoge2(strPath As String) As String
Dim fso As New FileSystemObject
hoge2=fso.GetFileName(strPath)
End Sub

じゃ、そゆことで。
    • good
    • 1
この回答へのお礼

ありがとうございます

そうか、FileSystemObjectか・・・
存在を忘れていました(笑)
参考になりました。早速使わせていただきますw

お礼日時:2001/11/21 09:24

お疲れ様です。



ファイル名の後ろから"."を探せばいいのではないでしょうか。

(例

  Dim ファイル名 As String
  Dim 名前 As String
  Dim 拡張子 As String
  Dim 位置 As Long

  ファイル名 = "AIUEO.TXT"

  位置 = InStrRev(ファイル名, ".") '// 後ろから文字を検索

  名前 = Left$(ファイル名, 位置 - 1) '// 名前が入る
  拡張子 = Right$(ファイル名, Len(ファイル名) - 位置) '// 拡張子が入る

(結果
  名前 = "AIUEO"
  拡張子 = "TXT"

間違っていたらごめんなさい。
    • good
    • 0
この回答へのお礼

おはようございます
お礼が遅くなって申し訳ありません!

InStrRevっていう関数があるんですねw
知らなかったな~^^
私はLen関数で文字列長を取得してから、Loopで回してました(笑)
勉強になりました!

お礼日時:2001/11/21 09:27

拡張子を認識するためのAPI関数があります。



ファイルのフルパスでもOK

'拡張子のピリオドを<<vbNullChar>>に変換するAPI関数
Private Declare Sub PathRemoveExtension Lib "shlwapi.dll" Alias "PathRemoveExtensionA" (ByVal pszPath As String)

Sub Main()
  Const FILE1 As String = "c:\test\index.html"
  Const FILE2 As String = "c:\test\index.html.doc.txt.wav"
  Const FILE3 As String = "index"
  Const FILE4 As String = "index.html.doc.txt.wav.ウィルス"

  Dim wkStr1 As String
  Dim wkStr2 As String

  Call GetGetGet(FILE1, wkStr1, wkStr2)
  MsgBox _
      "ファイル名:[" & FILE1 & "]" & vbNewLine & _
      "ファイル :[" & wkStr1 & "]" & vbNewLine & _
      "拡張子  :[" & wkStr2 & "]"
  
  Call GetGetGet(FILE2, wkStr1, wkStr2)
  MsgBox _
      "ファイル名:[" & FILE2 & "]" & vbNewLine & _
      "ファイル :[" & wkStr1 & "]" & vbNewLine & _
      "拡張子  :[" & wkStr2 & "]"
  
  Call GetGetGet(FILE3, wkStr1, wkStr2)
  MsgBox _
      "ファイル名:[" & FILE3 & "]" & vbNewLine & _
      "ファイル :[" & wkStr1 & "]" & vbNewLine & _
      "拡張子  :[" & wkStr2 & "]"
  
  Call GetGetGet(FILE4, wkStr1, wkStr2)
  MsgBox _
      "ファイル名:[" & FILE4 & "]" & vbNewLine & _
      "ファイル :[" & wkStr1 & "]" & vbNewLine & _
      "拡張子  :[" & wkStr2 & "]"
  Exit Sub
End Sub

Function GetGetGet(ByVal inFileName As String, ByRef outFileName As String, ByRef outKakutyousi As String)
  Dim valWork As Variant
  
  '戻りパラメータ初期化
  outFileName = ""
  outKakutyousi = ""
  
  '拡張子を<<vbNullChar>>に変換
  Call PathRemoveExtension(inFileName)
  
  'vbNullCharで切り分ける
  valWork = Split(inFileName, vbNullChar)
  
  '配列の先頭がファイル名
  outFileName = valWork(0)
  
  '拡張子が存在してない時は、以下を通らない
  If UBound(valWork) > 0 Then
    outKakutyousi = valWork(1)
  End If
End Function
    • good
    • 0
この回答へのお礼

御有難う御座りまスル!!

ムムム・・・・・・・・
何か非常に難しいですな
拙者の存ぜぬ関数なる物が
多分に表記されておる為か
理解に時が必要じゃw

拙者の現在の習熟能力では
把握出来ぬ故、暫しの時を
くだされ、勉学に勤しんで
みるとしよう・・・(笑)

VBって奥が深いですね!
まだまだ勉強が必要です。
皆さんホントにどうもです

o(o|o)/    (V)o\o(V)

お礼日時:2001/11/21 09:35

拡張子が.txtと決まっているのでしたら、


Left$(ファイル名,Len(ファイル名)-4)ではダメですか?

この回答への補足

たしかにCHOROLYNさんのおっしゃる方法で出来るのですが
今後は「.txt」以外のファイルでも対応していきたいので
拡張子を取るような関数でもあればと思って質問しました。
拡張子って3文字以外にもありますよね!
たとえば「.html」だとか「.il」だとか・・・
後ろから一文字ずつ検索して、ピリオドが出たら切るって方法も
あるのですが・・・(めんどい^^)

補足日時:2001/11/20 14:08
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

QVBAでブック名の拡張子を除去してシートにコピー

VBA初心者でコード作成で困っております。

下記の通りコードを組みましたが、シート名をブック名に変更して
保存したいのですが、このコードですと拡張子までついてしまいます。
拡張子を除去するためにはどうすればよいでしょうか?

アドバイス宜しくお願い致します。

Sub test()

'シート名の変更

Dim MyPath As String

Dim MyFile As String

Dim Wb As Workbook


MyPath = "C:\TEST\"

MyFile = Dir(MyPath & "*.xlsx")


Do While MyFile <> ""

Set Wb = Workbooks.Open(MyPath & MyFile)

ActiveSheet.Name = ActiveWorkbook.Name

Application.DisplayAlerts = False

Wb.Save

Application.DisplayAlerts = True

Wb.Close (False)

MyFile = Dir()

Loop

End Sub

VBA初心者でコード作成で困っております。

下記の通りコードを組みましたが、シート名をブック名に変更して
保存したいのですが、このコードですと拡張子までついてしまいます。
拡張子を除去するためにはどうすればよいでしょうか?

アドバイス宜しくお願い致します。

Sub test()

'シート名の変更

Dim MyPath As String

Dim MyFile As String

Dim Wb As Workbook


MyPath = "C:\TEST\"

MyFile = Dir(MyPath & "*.xlsx")


Do While MyFile <> ""
...続きを読む

Aベストアンサー

拡張子が .xlsx と決まっているなら

ActiveSheet.Name = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)

では?

QEXCEL VBAマクロ作成で、他のEXCELからデータを取り込みたい

メインプログラム(EXCEL VBA)より、
他のフォルダーにあるEXCELの項目の内容を取り込みたいです。
たとえば他のフォルダーのEXCELのRange("A2:A3").ValueをメインプログラムのRange("C2:C3").Valueにセットしたい時です。

・コマンドボタン押したら、どこのEXCELから取り込むかのポップアップ(?)は、表示はできてます。
・作業者が選んだパスとブックもMsgBoxで表示できてるので、もらう相手の場所も取得できてます。

・となると次はOPEN,INPUTですか?
テキストデータの取り込みですと、Inputでそのバッファを定義してるのですが、なんか違うような。。。

よろしくお願いします!

Aベストアンサー

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Cells(2, 2).Value ' 相手シートの B2 の値を自分自身の A1 に書き込む

readBook.Close False ' 相手ブックを閉じる
Set readSheet = Nothing
Set readBook = Nothing

私がやる方法です。

Dim writeSheet As Worksheet ' 自分自身の書き出し先シート
Set writeSheet = ThisWorkbook.Worksheets(1) ' Sheet1 を参照

Dim readBook As Workbook ' 相手ブック
Set readBook = Workbooks.Open(filename) ' 相手ブックを開いて参照
Dim readSheet As WorkSheet ' 相手シート
Set readSheet = readBook.Worksheets("sheetName") ' 相手シートを参照
' または Set readSheet = readBook.Worksheets(sheetIndex)

' 例えば
writeSheet.Cells(1, 1).Value = readSheet.Ce...続きを読む

Q文字列の後ろから必要分だけ削除したい。

例1 Dim str As String = "あいうえお1234"

文字列の中の1234だけ削除したい場合は、
str = str.Remove(5,4)
という風に、5文字目の後から4文字削除にすればよいのですが、

例の"あいうえお"の部分の長さが毎回処理する度に異なる場合は、
文字列の頭から何文字目という指定ができないので、”後ろから4文字を削除したい”となります。その場合は、どのようなプロパティを使えばいいのでしょうか。

.NET環境です。

Aベストアンサー

Length(str)で文字数を取得できますので、後ろから4文字目は先頭から何文字目かは計算できると思いますが、どうでしょうか?

Qエクセル マクロで指定フォルダを開く

エクセルにて
指定フォルダを開く、マクロがあれば教えて頂けないでしょうか。
よろしくお願いいたします。

Aベストアンサー

こんにちは。

こういうものですか?
開くフォルダを変えたいときは targ に与えるパスを変更します。

Sub OpenFolders()
Dim targ As String
targ = "C:\"
Shell "C:\Windows\Explorer.exe " & targ, vbNormalFocus
End Sub

QVB上で実行中の無限ループの止め方

今まで、CUIベースのBASICでのプログラムの経験はあるのですが
Visual系のBASICは初心者です。
原因はわかっているのでプログラムの修正はできるのですが
VB上でコンパイルして実行したときに無限ループに陥ってしまって
どうにもプログラムをとめられなくなります。
そんなことがないように、実行前に全てのプロジェクトを保存して
いますので、そんなに実害はないのですが、どうすればとめられるのでしょう・・
今現在は、タスクマネージャーから強制終了させています。

Aベストアンサー

無限ループの一番内側に
DoEvents
を入れておくと、ウィンドウ切替え->デバッガ終了操作が出来ますよ

危なそうなとこにも入れておくと、何かと安心です。

QEXCELファイルのカレントフォルダを取得するには?

EXCELファイルのカレントフォルダを取得するには?

C:\経理\予算.xls

D:\2005年度\予算.xls

EXCEL97ファイルがあります。

VBAで
  カレントフォルダ名
(C:\経理\,D:\2005年度\)
を取得する事は可能でしょうか?

CURDIRでは上手い方法が見つかりませんでした。

Aベストアンサー

こんばんは。
Excel97 でも、同じですね。以下で試してみてください。

Sub test()
'このブックのパス
a = ThisWorkbook.Path
'アクティブブックのパス
b = ActiveWorkbook.Path
'Excelで設定されたデフォルトパス
c = Application.DefaultFilePath
'カレントディレクトリ
d = CurDir
MsgBox "このブックのパス   : " & a & Chr(13) & _
   "アクティブブックのパス: " & b & Chr(13) & _
   "デフォルトパス    : " & c & Chr(13) & _
   "カレントディレクトリ : " & d & Chr(13)
End Sub

Q拡張子なしでファイル名を取得する

Windows7、EXCEL2013を使用しています。

VBAを使い、任意のフォルダを指定し、その中にあるファイル名を
・拡張子ありで取得するコマンドボタン(オブジェクト名:output)
・拡張子なしで取得するコマンドボタン(オブジェクト名:output_n)
の2パターンで取得するものをつくりたいと考えています。

拡張子ありのほうは、以下のように作成しました。
-----------------------------------------------------------
Private Sub output_Click()

Dim Target As String
Dim Extraction As Variant
Dim buf As String
Dim i As Long


'入力欄の値を取得

Target = Target_i.Value

'ファイル名取得
If Target = "" Then
MsgBox "パスを入力してください"
Exit Sub
End If

buf = Dir(Target & "*.*")

Do While buf <> ""
i = i + 1
Cells(i, 1) = buf
buf = Dir()
Loop

MsgBox i & "件ありました。"

End Sub
-----------------------------------------------------------
拡張子ありのこのコードは問題なく動作しています。
これを応用して拡張子なしに対応したものを作成したいのですが、
以下のようなコードにしたところ、エラーとなりました。
-----------------------------------------------------------
Private Sub output_n_Click()

Dim Target As String
Dim buf As String
Dim i As Long
Dim FileName As Object

Dim sFilename As String
Dim Findpoint As Long
Dim strLen As Long

'入力欄の値を取得
Target = Target_i.Value


'空白かチェック
If Target = "" Then
MsgBox "パスを入力してください"
Exit Sub
End If

'ファイル名取得
buf = Dir(Target & "*.*")

'拡張子をとる
sFilename = buf.getbasename(sFilename)   ←ここのbufが黄色で反転

Do While strPath <> ""
i = i + 1
Cells(i, 1) = strPath
strPath = Dir()
Loop

MsgBox i & "件ありました。"

End Sub
-----------------------------------------------------------
エラー内容は、
【コンパイルエラー:装飾子が不正です。】です。

一度ファイル名を取得し、拡張子をとった値を返したいのですが、
取得したファイル名(buf)から拡張子をとるにはどうすればよいでしょうか。

にわかの私にはこれ以上がわかりません。
どなたか教えてください。

宜しくお願いします。

Windows7、EXCEL2013を使用しています。

VBAを使い、任意のフォルダを指定し、その中にあるファイル名を
・拡張子ありで取得するコマンドボタン(オブジェクト名:output)
・拡張子なしで取得するコマンドボタン(オブジェクト名:output_n)
の2パターンで取得するものをつくりたいと考えています。

拡張子ありのほうは、以下のように作成しました。
-----------------------------------------------------------
Private Sub output_Click()

Dim Target As String
Dim Extraction As Variant
...続きを読む

Aベストアンサー

こんにちは。

ふつう、このような場合は、FileSystemObject (objFS) ではなく、InstrRev で、後ろから、コンマを探して、切り捨てます。

例:
Fn = "Test1.xlsx"
i = InStrRev(Fn, ".")
Debug.Print Left(Fn, i - 1)

なぜ、FileSystemObjectを使わないかというと、オブジェクトを呼びこむ時の時間、つまりオーバーヘッドが掛かるからです。今回は、ご質問者様の内容をそのまま活かしました。

'//
Private Sub output_n_Click()
 Dim Target   As String
 Dim Target_i   As Range
 Dim objFS   As Object 'FileSystemObject
 Dim buf    As String
 Dim i     As Long
 Dim FileName  As Object
 Dim strPath  As String
 Dim Findpoint As Long
 Dim strLen   As Long
 
 Set objFS = CreateObject("Scripting.FilesystemObject")
 
'入力欄の値を取得
 Set Target_i = ActiveCell '←※臨時で置きました。
 Target = Target_i.Value

'空白かチェック
If Target = "" Then
  MsgBox "パスを入力してください"
  Exit Sub
End If

'ファイル名取得
buf = Dir(Target & "*.*")
'拡張子をとる
 Do
 i = i + 1
 strPath = objFS.GetBaseName(buf) 'ループの中に入れました。
 Cells(i, 1).Value = strPath
 buf = Dir()
 Loop While buf <> "" '判定はbuf でします。
 
 MsgBox i & "件ありました。"
End Sub
'//

こんにちは。

ふつう、このような場合は、FileSystemObject (objFS) ではなく、InstrRev で、後ろから、コンマを探して、切り捨てます。

例:
Fn = "Test1.xlsx"
i = InStrRev(Fn, ".")
Debug.Print Left(Fn, i - 1)

なぜ、FileSystemObjectを使わないかというと、オブジェクトを呼びこむ時の時間、つまりオーバーヘッドが掛かるからです。今回は、ご質問者様の内容をそのまま活かしました。

'//
Private Sub output_n_Click()
 Dim Target   As String
 Dim Target_i   As Range
 Di...続きを読む

QVBでファイルが開かれているかどうかを確認したい

お疲れ様です。

Open ステートメントで開いたファイルが、閉じていなければ閉じると言う処理をしたいのですが、ファイルが開きっぱなしかどうかを確認するには、どんな方法があるのでしょうか?

よろしくお願いします。

Aベストアンサー

こんにちは

もう一度同じファイルを同じファイルNo.(#1)で
開きに行くと、
開きっぱなしなら“すでに開いています”とエラーになって
閉じていたら、エラーがないので
判断出きるはずです。

QEXCELマクロで上書きメッセージ無しで保存する方法

EXCELマクロで上書きメッセージ無しで保存する方法をお願いします
ActiveWorkbook.SaveAs "C:\Documents andSettings\Nakatani\MyDocuments\Book1.xls"
の様にするとすでにファイルがある場合上書きメッセージが出ます
メッセージを出さずに上書きするプログラミングを教えて下さい
宜しくお願いします

Aベストアンサー

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "C:\Documents andSettings\Nakatani\MyDocuments\Book1.xls"
Application.DisplayAlerts = True


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング