OKWAVEのAI「あい」が美容・健康の悩みに最適な回答をご提案!
-PR-
解決
済み

説明に自信ありませんが。

  • すぐに回答を!
  • 質問No.168539
  • 閲覧数59
  • ありがとう数3
  • 気になる数0
  • 回答数3
  • コメント数0

お礼率 73% (71/96)

以前質問させていただいた者です、
解答していただいた方ありがとうございました。
さっそく本屋さんで見てみましたが、私が理解するには多少なりとも
プログラムに詳しい人がそばいないと難しいと思い、
改めて質問させていただきます。
自分にはプログラムはまだまだ時間がかかるので、以下のような
処理の可能なソフトを探しています。何かありますでしょうか?
画像データを取り扱うもので、以下のような処理をしたいのですが・・。
データベースフォルダ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は同じ画像になります)。
こんなかんじですが、いかがなものでしょう?やはり一般人にこなせるレベルじゃないですか?
通報する
  • 回答数3
  • 気になる
    質問をブックマークします。
    マイページでまとめて確認できます。

質問者が選んだベストアンサー

  • 回答No.3
レベル12

ベストアンサー率 65% (276/422)

環境が書いてなかったから、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
お礼コメント
kenta1005

お礼率 73% (71/96)

またまた返事が遅れてしまいました。
ようやく、プログラム自体稼動するようになりました。
本当にありがとうございました。
投稿日時 - 2001-12-13 09:05:32
-PR-
-PR-

その他の回答 (全2件)

  • 回答No.1
レベル12

ベストアンサー率 65% (276/422)

サンプルです。 処理内容としては 1.キーを元に"*-00001-*.jpg"というようなパターンを作成 2.ファイルリすとボックスにパターンをセット 3.ファイルのカウントをファイルリストボックスから読み取る 4.新たな名前の作成をしてコピー 必要なオブジェクト/コントロール フォーム1[Form1] │ ├コマンドボタン1[Command1] │ ...続きを読む
サンプルです。

処理内容としては
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
補足コメント
kenta1005

お礼率 73% (71/96)

お礼が遅くなりました、すみません。実はこのプログラムいただいてから
アクセスの基礎から勉強していたもので・・。で、ソフトの概要はそこそこつかめたのですが、この命令文を何処に貼り付ければよいのかわからなくて・・。
新規フォームを作成し、コマンド1ボタンとコマンド2ボタンとリストボックスを作成、コマンド1ボタンの「クリック時」のイベントプロージャに貼り付けてみたのですが、うまくいかなくて・・。リストボックスは見えなくなってしまうし、エラーで File1.Path = DIR_DB_B の行にエラーがあるらしくそれを飛ばすと今度は Me.Command1.Enabled = False の所でもコントロールがなんたらとエラーが出てしまい、アクセスVBAの本を片手に途方に暮れています。もう少し具体的に教えていただけるとうれしいのですが・・・。
    
    
    
投稿日時 - 2001-11-29 09:21:29


  • 回答No.2
レベル12

ベストアンサー率 65% (276/422)

すいません訂正です Option Explicit ↑これ二つ存在してます。一つでいいです。 Private lngCntKey  As Long   'キーを配列で記憶 Private valKwyAry  As Variant 'キーの数 コメントが反対です Private lngCntKey  As Long   'キーの数 Priva ...続きを読む
すいません訂正です

Option Explicit
↑これ二つ存在してます。一つでいいです。


Private lngCntKey  As Long   'キーを配列で記憶
Private valKwyAry  As Variant 'キーの数
コメントが反対です
Private lngCntKey  As Long   'キーの数
Private valKwyAry  As Variant 'キーを配列で記憶
が正しいです。

あとロード時のコマンドボタン2のキャプションがリネームになってますが、機能はリネームではありません。コピーです。

過去のファイルから引っぱってきて作成したサンプルなので、修正し忘れてました。。。
このQ&Aのテーマ
このQ&Aで解決しましたか?
関連するQ&A
-PR-
-PR-
こんな書き方もあるよ!この情報は知ってる?あなたの知識を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する
-PR-
-PR-
-PR-

特集


いま みんなが気になるQ&A

関連するQ&A

-PR-

ピックアップ

-PR-
ページ先頭へ