以前質問させていただいた者です、
解答していただいた方ありがとうございました。
さっそく本屋さんで見てみましたが、私が理解するには多少なりとも
プログラムに詳しい人がそばいないと難しいと思い、
改めて質問させていただきます。
自分にはプログラムはまだまだ時間がかかるので、以下のような
処理の可能なソフトを探しています。何かありますでしょうか?
画像データを取り扱うもので、以下のような処理をしたいのですが・・。
データベースフォルダA
001.jpg 002.jpg 003.jpg 004.jpg ・・・ 2000.jpg
(1) 数字を入力
352 200 212 1555 2 33 525 223 200 33 33 ・・・
(2) 実行
352をキーに352.jpgを検索し 1-00352-001.jpg とファイル名を変更して
データベースフォルダBに。
200をキーに200.jpgを検索し 2-00200-001.jpg とファイル名を変更して
データベースフォルダBに。
212をキーに212.jpgを検索し 3-00212-001.jpg とファイル名を変更して
データベースフォルダBに。
同様に 1555から 4-01555-001.jpg 2から 5-00002-001.jpg
33から 6-00033-001.jpg 525から 7-00525-001.jpg
223から 8-00223-001.jpg そして、同じ番号がキーに
なっている場合(次の200の場合)
200.jpgを 9-00200-002.jpgと変更してデータベースフォルダBに。
その次の33は33.jpgを 10-00033-002.jpg 次は 11-00033-003.jpg
と言うように、データベースAから
(1から連番)-(検索されたファイルの数字)-(そのファイルの検索された回数).jpg
と名前を変更したものをデータベースBとして作成したいのですが・・。
(例えば2-00200-001.jpg と 9-00200.002.jpgは同じ画像になります)。
こんなかんじですが、いかがなものでしょう?やはり一般人にこなせるレベルじゃないですか?
No.3ベストアンサー
- 回答日時:
環境が書いてなかったから、VB6だと思ってました...
アクセスだったのですね(^^;)
アクセスだと・・・
ファイルリストボックスはありません。
フォーカスを持っているコントロールを使用不可にできません。
恐らくそれがエラーの原因になってると思います。
ですので、for アクセス バージョンです。
'処理内容としては
'1.キーを元に"*-00001-*.jpg"というようなパターンを作成
'2.getFiles関数により同パターンのファイル数を取得
'3.新たな名前の作成をしてコピー
'
'
'必要なオブジェクト/コントロール
'フォーム1
'│
'├コマンドボタン1 [Command1]
'│
'└コマンドボタン2 [Command2]
Option Compare Database
Option Explicit
Private Const RENAME_KEY_FILE As String = "c:\TEST.txt"
Private Const RENAME_KRY_CUT As String = ","
Private Const DIR_DB_A As String = "C:\A\"
Private Const DIR_DB_B As String = "C:\B\"
Private lngCntKey As Long 'キーの数
Private valKwyAry As Variant 'キーを配列で記憶
'キーファイルを読み取る
Private Sub Command1_Click()
Dim lngFile As Long
Dim lngFileSize As Long
Dim strWork As String
'--- キーファイルから、文字列の取得 ---
lngFileSize = FileLen(RENAME_KEY_FILE)
strWork = String(lngFileSize, vbNullChar)
lngFile = FreeFile
Open RENAME_KEY_FILE For Binary As #lngFile
'バッファ取得
Get #lngFile, , strWork
Close #lngFile
'---- 取得した文字列の分解 ---
On Error Resume Next
lngCntKey = 0
Erase valKwyAry
valKwyAry = Split(strWork, RENAME_KRY_CUT) 'サンプルではカンマ区切り
lngCntKey = UBound(valKwyAry) + 1 'キーの数を得る
On Error GoTo 0
'キーが存在したらリネーム処理ボタン使用可能
If (lngCntKey > 0) Then
Me.Command2.Enabled = True
Me.Command2.SetFocus
Me.Command1.Enabled = False
MsgBox "キー情報を取得しました"
Else
MsgBox "キー情報を取得できませんでした"
End If
End Sub
Private Sub Command2_Click()
Dim i As Long
Dim strFileName As String
Dim strNewFileName As String
Dim strPattern As String
Dim lngCntMain As Long
Dim lngCntSub As Long
Dim lngFileCnt As Long
With Me
'メインカウンタの初期化
lngCntMain = 0
For i = 0 To lngCntKey - 1
'ファイル名を作成
strFileName = DIR_DB_A & valKwyAry(i) & ".jpg"
'ファイルの有無を調べる
If Dir(strFileName) <> "" Then
'--- 存在したら ---
'メインカウンタを1増やす
lngCntMain = lngCntMain + 1
'新たなファイル名の途中部分をパターンを作成
strPattern = "*-" & Format(valKwyAry(i), "00000") & "-*.jpg"
'作成したパターンのファイルが、コピー先に何個あるかを得る
lngFileCnt = getFiles(DIR_DB_B, strPattern)
'サブカウンタをセット(同じパターンのファイル数+1)
lngCntSub = lngFileCnt + 1
'コピー先名を定義
strNewFileName = DIR_DB_B & _
lngCntMain & "-" & _
Format(valKwyAry(i), "00000") & "-" & _
Format(lngCntSub, "000") & ".jpg"
'コピー
Call FileCopy(strFileName, strNewFileName)
End If
Next i
End With
MsgBox "変更終了しました"
End Sub
Private Sub Form_Load()
With Me
.Command1.Caption = "ファイル取得"
.Command2.Caption = "コピー実行"
.Command2.Enabled = False
End With
End Sub
'【機 能】 :フォルダ内に存在するファイルの数を取得する
'【返り値】 :フォルダに含むファイルの数
'''パラメータ1(inPath) :ファイルパス
'''パラメータ2(inFileFilter) :ファイルのフィルタ
Private Function getFiles(inPath As String, inFileFilter As String) As Long
Dim strFileName As String
'最初ののJEPGファイルを見つける
strFileName = Dir(inPath & inFileFilter)
'取得できなくなるまで繰り返す
Do While strFileName <> ""
'拡張子を持っているようなフォルダ名をはじく処理
If (GetAttr(inPath & strFileName) And vbDirectory) <> vbDirectory Then
getFiles = getFiles + 1
End If
'次のファイルを取得する
strFileName = Dir
Loop
End Function
No.2
- 回答日時:
すいません訂正です
Option Explicit
↑これ二つ存在してます。一つでいいです。
Private lngCntKey As Long 'キーを配列で記憶
Private valKwyAry As Variant 'キーの数
コメントが反対です
Private lngCntKey As Long 'キーの数
Private valKwyAry As Variant 'キーを配列で記憶
が正しいです。
あとロード時のコマンドボタン2のキャプションがリネームになってますが、機能はリネームではありません。コピーです。
過去のファイルから引っぱってきて作成したサンプルなので、修正し忘れてました。。。
No.1
- 回答日時:
サンプルです。
処理内容としては
1.キーを元に"*-00001-*.jpg"というようなパターンを作成
2.ファイルリすとボックスにパターンをセット
3.ファイルのカウントをファイルリストボックスから読み取る
4.新たな名前の作成をしてコピー
必要なオブジェクト/コントロール
フォーム1[Form1]
│
├コマンドボタン1[Command1]
│
├コマンドボタン2[Command2]
│
└ファイルリストボックス[File1]
あとサンプルでは
Private Const RENAME_KEY_FILE As String = "c:\TEST.txt"
Private Const RENAME_KRY_CUT As String = ","
として、キーをファイルから読み取ってます。
カンマ区切りのキーが入ったテキストファイルが必要です。
元のJPGフォルダ[DIR_DB_A]
出力先のJPGフォルダ[DIR_DB_A]
で宣言してあるので、任意に変更してください。
Option Explicit
Option Explicit
Option Compare Text 'ここに記されているプログラムは、文字列の比較を大文字小文字の区別をしない事を宣言
Private Const RENAME_KEY_FILE As String = "c:\TEST.txt"
Private Const RENAME_KRY_CUT As String = ","
Private Const DIR_DB_A As String = "C:\A\"
Private Const DIR_DB_B As String = "C:\B\"
Private lngCntKey As Long 'キーを配列で記憶
Private valKwyAry As Variant 'キーの数
'キーファイルを読み取る
Private Sub Command1_Click()
Dim fileBuf() As Byte
Dim lngFile As Long
Dim lngFileSize As Long
Dim strWork As String
'--- キーファイルから、文字列の取得 ---
lngFileSize = FileLen(RENAME_KEY_FILE)
ReDim fileBuf(lngFileSize - 1) As Byte
lngFile = FreeFile
Open RENAME_KEY_FILE For Binary As #lngFile
'バッファ取得
Get #lngFile, , fileBuf
Close #lngFile
strWork = StrConv(fileBuf, vbUnicode)
'---- 取得した文字列の分解 ---
On Error Resume Next
lngCntKey = 0
Erase valKwyAry
valKwyAry = Split(strWork, RENAME_KRY_CUT) 'サンプルではカンマ区切り
lngCntKey = UBound(valKwyAry) + 1 'キーの数を得る
On Error GoTo 0
'キーが存在したらリネーム処理ボタン使用可能
If (lngCntKey > 0) Then
Me.Command1.Enabled = False
Me.Command2.Enabled = True
MsgBox "キー情報を取得しました"
Else
MsgBox "キー情報を取得できませんでした"
End If
End Sub
Private Sub Command2_Click()
Dim i As Long
Dim strFileName As String
Dim strNewFileName As String
Dim strPattern As String
Dim lngCntMain As Long
Dim lngCntSub As Long
With Me
lngCntMain = 0
'ファイルリすとボックスのパスを設定
.File1.Path = DIR_DB_B
For i = 0 To lngCntKey - 1
'ファイル名を作成
strFileName = DIR_DB_A & valKwyAry(i) & ".jpg"
'ファイルの有無を調べる
If Dir(strFileName) <> "" Then
'--- 存在したら ---
'リネームのカウンタを1増やす
lngCntMain = lngCntMain + 1
'新たなファイル名の途中部分を定義
strPattern = "*-" & Format(valKwyAry(i), "00000") & "-*.jpg"
.File1.Pattern = strPattern
.File1.Refresh
'サブカウンタをセット
lngCntSub = .File1.ListCount + 1
'新たな名前を定義
strNewFileName = DIR_DB_B & _
lngCntMain & "-" & _
Format(valKwyAry(i), "00000") & "-" & _
Format(lngCntSub, "000") & ".jpg"
'コピー
FileCopy strFileName, strNewFileName
End If
Next i
End With
MsgBox "変更終了しました"
End Sub
Private Sub Form_Load()
With Me
.Command1.Caption = "ファイル取得"
.Command2.Caption = "リネーム実行"
.Command2.Enabled = False
.File1.Visible = False
End With
End Sub
この回答への補足
お礼が遅くなりました、すみません。実はこのプログラムいただいてから
アクセスの基礎から勉強していたもので・・。で、ソフトの概要はそこそこつかめたのですが、この命令文を何処に貼り付ければよいのかわからなくて・・。
新規フォームを作成し、コマンド1ボタンとコマンド2ボタンとリストボックスを作成、コマンド1ボタンの「クリック時」のイベントプロージャに貼り付けてみたのですが、うまくいかなくて・・。リストボックスは見えなくなってしまうし、エラーで File1.Path = DIR_DB_B の行にエラーがあるらしくそれを飛ばすと今度は Me.Command1.Enabled = False の所でもコントロールがなんたらとエラーが出てしまい、アクセスVBAの本を片手に途方に暮れています。もう少し具体的に教えていただけるとうれしいのですが・・・。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- その他(ソフトウェア) 画像のファイル形式、拡張子が変わると、性能が変わると思うのですが、ファイル名の「jpg、png、do 8 2022/08/10 13:37
- Excel(エクセル) Excel 毎日手作業で時間がかかって、泣きたいです、、、VBAのプロの方、助けてください。。。 3 2022/10/25 04:26
- PHP 画像ファイルの名前をそのままURLにする 3 2022/10/16 11:18
- Windows 10 JPG PNG サポートされていない形式 (JPGファイルで開ける、開けないがある場合) 4 2022/04/23 13:46
- その他(ソフトウェア) コマンドプロンプトについて教えてください。 状況: 画像編集ソフト上でネットから保存した画像を使うの 3 2022/05/26 11:14
- PDF pdfファイルのjpgファイルへの変換 5 2022/06/03 10:13
- PHP $filePath = './user_img/' . $file['name'];? 1 2022/12/10 07:29
- iOS ファイルの名前変更 2 2022/08/11 20:47
- デジタルカメラ 写真のファィル形式について 4 2022/10/12 14:18
- その他(パソコン・スマホ・電化製品) 拡張子の選択方法について 4 2022/09/22 22:04
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【ACCESS VBA】アクセスからデ...
-
複数のワークブックのVBAを変更...
-
VBAでフォルダ内のhtmlファイル...
-
ffftpでファイル取得が0バイト...
-
エクセルのVBAで開いている...
-
VBからExcelファイルを開くとき...
-
仕事で使用するマクロのコード...
-
vbaサブフォルダーをワイルドカ...
-
WSHでテキストファイルを修正し...
-
ファイル番号の取得について
-
遅延バインディングの回避方法
-
excel マクロ PDF化の際のエラ...
-
FTP対応のアプリケーション
-
「エクセルファイルが開いてい...
-
タイムスタンプの更新の方法2
-
Long型で表現できないファイル...
-
「AccessViolationException」...
-
VB.Netソリューションでフォー...
-
vbsでのアスタリスクとファイル...
-
EXCEL VBA tif画像のプロパティ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
動かなくなってしまった古いVBA...
-
FileDialog オブジェクトでファ...
-
VBA ファイル名取得
-
VBAでフォルダ内のhtmlファイル...
-
excel マクロ PDF化の際のエラ...
-
vbsでのアスタリスクとファイル...
-
「エクセルファイルが開いてい...
-
ffftpでファイル取得が0バイト...
-
vbaサブフォルダーをワイルドカ...
-
ExcelVBA 文字コード変換
-
Accessのウインドウサイズの固定
-
サブフォルダ含むフォルダ内の...
-
VBからExcelファイルを開くとき...
-
VB6でUTF-8ファイルの読取りを
-
【VBAマクロ初心者】Excel VBA...
-
「AccessViolationException」...
-
エクセルのVBAで開いている...
-
Wordのプロパティ・総ページ数...
-
更新日が指定日以降のファイル取得
-
コモンダイアログでフォルダを...
おすすめ情報