tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板 [ツリー表示へ]   [Home]
一括表示(VB6.0)
タイトルExcelが解放されない
記事No14807
投稿日: 2010/07/08(Thu) 18:27
投稿者rgnoo
いつもお世話になっております。
VB6初心者でございます。
今、VB6からエクセルの制御を行っております。
タイトルにもございますが、エクセルが解放されず困っております。
正確に言いますと、下記プログラム単体で動かすと、エクセルが解放されるのですが、
このプログラムを、関数として、別プログラムに組み込んで使用しますと、エクセルが解放されなくなってしまいます。
組み込んだプログラムを終了すると、エクセルは解放されます。
当方、いろいろと調査したのですが、原因がわからず大変困っております。
どなたかご教授いただけませんでしょうか。
少々長いプログラムで、読みにくいかもしれませんが、よろしくお願い致します。
お忙しい所誠に恐縮ですが以上よろしくお願い致します。

開発環境
VB6 SP3
WinXP Pro SP2
Office2000 Standard
IE6

Private Sub PPKInput()
Dim Series As String 'KQかKQCか
Dim Bunkatu As String   '_2か_1(PPK管理図のファイル名の後ろの部分 06Ppk管理図KQ_2.xls)
Dim fsoFolExi As New FileSystemObject  
Dim fsoFolCop As New FileSystemObject
Dim fsoFilCop As New FileSystemObject
Dim strPpkFolNam_Path As String  'PPK管理図のフォルダのパス
Dim strPpkBacFolNam_Path As String 'Ppk管理図(バックアップ)のフォルダのパス

Dim xlApp    As Excel.Application
Dim xlBook   As Excel.Workbook  
Dim xlSheet As Excel.Worksheet  

'KQかKQCの判別
If Mid(InputKQCode, 3, 1) = "0" Or Mid(InputKQCode, 3, 1) = "M" Then 'InputKQCode(ex,KQM622N)
    Series = "KQ"
Else
    Series = "KQC"
End If
    
If InStr(Mid(InputKQCode, 5, 3), "R") >= 2 Then 'InputKQCode(ex,KQM622N)の5個めから3つ(ex,1R0、1R2)のRの位置が2以上の場合
    If Series = "KQ" And Replace(Mid(InputKQCode, 5, 3), "R", "00") >= 47 Then 'series="KQ"かつInputKQCode(ex,KQM622N)の5個めから3つ(ex,1R0、1R2)のRを00に変えた数(ex,1R0なら1000)が47以上の場合
       Bunkatu = "_2"
    ElseIf Series = "KQ" And Replace(Mid(InputKQCode, 5, 3), "R", "00") < 47 Then 'series="KQ"かつInputKQCode(ex,KQM622N)の5個めから3つ(ex,1R0、1R2)のRを00に変えた数(ex,1R0なら1000)が47より小さい場合
       Bunkatu = "_1"
    Else: Bunkatu = ""
    End If

ElseIf InStr(Mid(InputKQCode, 5, 3), "N") >= 2 Then 'InputKQCode(ex,KQM622N)の5個めから3つ(ex,1N6、10N)のNの位置が2以上の場合
    If Series = "KQ" And Replace(Mid(InputKQCode, 5, 3), "N", ".") >= 47 Then 'series="KQ"かつInputKQCode(ex,KQM622N)の5個めから3つ(ex,1N6、10N)のNを.に変えた数(ex,1N6なら1.6)が47以上の場合
       Bunkatu = "_2"
    ElseIf Series = "KQ" And Replace(Mid(InputKQCode, 5, 3), "N", ".") < 47 Then 'series="KQ"かつInputKQCode(ex,KQM622N)の5個めから3つ(ex,1N6、10N)のNを.に変えた数(ex,1N6なら1.6)が47より小さい場合
       Bunkatu = "_1"
    Else: Bunkatu = ""
    End If

ElseIf Series = "KQ" And Mid(InputKQCode, 5, 3) >= 47 Then 'series="KQ"かつInputKQCode(ex,KQM622N)の5個めから3つ(ex,1N6、10N)が47以上の場合
        
    Bunkatu = "_2"

ElseIf Series = "KQ" And Mid(InputKQCode, 5, 3) < 47 Then 'series="KQ"かつInputKQCode(ex,KQM622N)の5個めから3つ(ex,1N6、10N)が47より小さい場合
        
    Bunkatu = "_1"

Else: Bunkatu = ""

End If

'Ppk管理図への入力
'Ppk管理図のフォルダ名(メイン)
strPpkFolNam_Path = "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\Ppk管理図" & Gouki

'Ppk管理図のフォルダ有無
If fsoFolExi.FolderExists(strPpkFolNam_Path) <> "true" Then
  
    'Ppk管理図(原紙)フォルダを\\Kq-001\工程集計\工程不良集計\Ppk集計フォルダにコピーする
    fsoFolCop.CopyFolder "\\Kq-001\工程集計\原紙ファイル\Ppk管理図(原紙)", _
                         "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\"      
    'フォルダ名の変更
    '”Ppk管理図(原紙)”フォルダの名前を、”Ppk管理図28”に変更する。
    Name "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\" & "\Ppk管理図(原紙)" _
      As "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\" & "\Ppk管理図" & Gouki
      
End If

Set xlApp = CreateObject("Excel.Application")

'Ppk管理図ファイルのオープン
Set xlBook = xlApp.Workbooks.Open("\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\Ppk管理図" _
                            & Gouki & "\06\06Ppk管理図" & Series & "" & Bunkatu & ".xls")

Set xlSheet = xlBook.Worksheets(L_Value)

'xlApp.Visible = True    'エクセルを表示
xlApp.Application.ScreenUpdating = True '画面の描画をONに戻す
    
xlBook.Sheets(L_Value).Select '対象L値のシート選択
xlSheet.Range("A1:BA39").Select 'A1からBA39を選択

xlApp.ActiveWindow.Zoom = True

xlSheet.Range("A1").Select   'A1セルを選択

xlApp.Application.ScreenUpdating = False   '画面の描画をOFFにする

If xlSheet.Cells(29, 51) = Empty Then  'Ppk管理図ファイルのセル(29行, 51列)が空の場合
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(0, 1) = Now               '月
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(1, 0) = Now               '日
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(2, 0) = P_p_k             'Ppk
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(3, 0) = Average           'アベレージ(%)
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(4, 0) = SEISANLot          'ロットNo
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(5, 0) = pstrPRGNo         'PRGNo
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(6, 0) = pstrYUUKOUMAKISUU '有効巻数
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(7, 0) = pstrPitch         'ピッチ/微調整
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(8, 0) = pstrMakihazimeichi '巻始位置/微調整
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(9, 0) = pstrNyuusenichi   '入線位置
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(10, 0) = pstrSeisouKenmaCycle '清掃研磨サイクル

Else
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(0, 1) = Now               '月
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(1, 0) = Now               '日
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(2, 0) = P_p_k             'Ppk
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(3, 0) = Average            'アベレージ(%)
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(4, 0) = SEISANLot             'ロットNo
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(5, 0) = pstrPRGNo         'PRGNo
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(6, 0) = pstrYUUKOUMAKISUU '有効巻数
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(7, 0) = pstrPitch         'ピッチ/微調整
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(8, 0) = pstrMakihazimeichi '巻始位置/微調整
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(9, 0) = pstrNyuusenichi   '入線位置
    xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(10, 0) = pstrSeisouKenmaCycle '清掃研磨サイクル
    
    xlApp.ActiveWindow.SelectedSheets.PrintOut Copies:=1  'Ppk管理図印刷
    '29行3列目から39行52列目の数式と文字を削除する
    xlSheet.Range(xlSheet.Cells(29, 3), xlSheet.Cells(39, 52)).ClearContents

End If

'Ppk管理図ファイルの保存
xlBook.Save   'ブックの保存

'Ppk管理図のフォルダ名(バックアップ)
strPpkBacFolNam_Path = "\\Kq-001\SETKQFILE\工程不良集計\Ppk集計" & "\Ppk管理図" & Gouki

'Ppk管理図のフォルダ有無(バックアップ)
'\\Kq-001\SETKQFILE\工程不良集計\Ppk集計フォルダにフォルダ(ex、PPK管理図28)が存在するか調べる
If fsoFolExi.FolderExists(strPpkBacFolNam_Path) <> "true" Then  '存在しない場合
  
    'フォルダのコピー
    '\\Kq-001\SETKQFILE\工程不良集計\Ppk集計フォルダに、PPK管理図(原紙)フォルダ(フォルダの中身全て)がコピーされる
    fsoFolCop.CopyFolder "\\Kq-001\工程集計\原紙ファイル\Ppk管理図(原紙)", _
                            "\\Kq-001\SETKQFILE\工程不良集計\Ppk集計" & "\"
    
    'フォルダ名の変更
    'PPK管理図(原紙)フォルダの名前をPPK管理図28フォルダに変更する
    Name "\\Kq-001\SETKQFILE\工程不良集計\Ppk集計" & "\" & "\Ppk管理図(原紙)" As _
          "\\Kq-001\SETKQFILE\工程不良集計\Ppk集計" & "\" & "\Ppk管理図" & Gouki

End If

'バックアップファイル(Ppk管理図)のコピー
fsoFilCop.CopyFile ActiveWorkbook.Path & "\" & ActiveWorkbook.Name, _
                    "\\Kq-001\SETKQFILE\工程不良集計\Ppk集計" & "\Ppk管理図" & Gouki & _
                    "\06\06Ppk管理図" & Series & "" & Bunkatu & ".xls"

xlApp.Application.ScreenUpdating = True   '画面の描画をONに戻す

'☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆
'ここでエクセルが解放されません

Set xlSheet = Nothing 'オブジェクトを解放
xlBook.Close            'Bookを閉じる
Set xlBook = Nothing 'オブジェクトを解放
xlApp.Quit              'Quitメソッドを使ってExcelを終了
Set xlApp = Nothing 'オブジェクトを解放
'☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆
End Sub

[ツリー表示へ]
タイトルRe: Excelが解放されない
記事No14808
投稿日: 2010/07/09(Fri) 01:33
投稿者魔界の仮面弁士
> VB6 SP3
> WinXP Pro SP2
> Office2000 Standard
> IE6
XP 付属の VB ランタイムは、VB6 SP3 の物より後継バージョンであるため、
上記の組み合わせで VB6 SP3 を使うのは問題があります。SP6 にしましょう。

同様に、Office 2000 についても、最新の Service Pack を適用すべきです。

# WinXP の Service Pack を更新するかどうかは任意ですが。


>  fsoFilCop.CopyFile ActiveWorkbook.Path & "\" & ActiveWorkbook.Name, _
>                     "\\Kq-001\SETKQFILE\工程不良集計\Ppk集計" & "\Ppk管理図" & Gouki & _
>                     "\06\06Ppk管理図" & Series & "" & Bunkatu & ".xls"
原因はここですね。どのオブジェクトの ActiveWorkbook プロパティなのかが明示されていません。
xlApp.ActiveWorkbook などのようにすれば、とりあえずは解決すると思います。
http://hanatyan.sakura.ne.jp/vbhlp/ExcelErr.htm

ただし今回の場合、操作しているブックは xlBook 変数に格納されているはずですから、
本来は、そもそも ActiveWorkbook プロパティの出番自体が無いはずです。コードを見直してみましょう。


> 少々長いプログラムで、読みにくいかもしれませんが、よろしくお願い致します。
ついでに、他の場所についても幾つか指摘を。



>  Dim xlApp    As Excel.Application
>  Set xlApp = CreateObject("Excel.Application")
参照設定しているなら、「Set xlApp = New Excel.Application」の方が良いでしょう。


>  Set xlBook = xlApp.Workbooks.Open("\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\Ppk管理図" _
>                             & Gouki & "\06\06Ppk管理図" & Series & "" & Bunkatu & ".xls")
「& "" &」というのは「&」と同じ意味ですので、無駄な記述に見えます。

また「"\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\Ppk管理図"」についても、
単に「"\\Kq-001\工程集計\工程不良集計\Ppk集計\Ppk管理図"」で良いのでは無いでしょうか。
(これと同様の冗長的な文字列操作が、他にも数箇所見受けられます)


>  xlApp.Application.ScreenUpdating = True '画面の描画をONに戻す
xlApp.ScreenUpdating と
xlApp.Application.ScreenUpdating と
xlApp.Application.Application.ScreenUpdating と
xlApp.Application.Application.Application.ScreenUpdating は、
いずれも同じ意味になります。

通常、Application プロパティの出番は無いはずです。xlApp を使うようにしましょう。


>  Set xlSheet = xlBook.Worksheets(L_Value)
>  xlBook.Sheets(L_Value).Select '対象L値のシート選択
L_Value というのが、シート名を表す文字列なのか、シート番号を示す自然数なのか
読み取れませんでしたが、恐らく、ここでいう xlBook.Worksheets(L_Value) と
xlBook.Sheets(L_Value) は、同じシートを表しているのですよね?

同じシートならば、最初に取得した xlSheet 変数を使って制御するようにすべきです。

もし両者が違うシートを意味しているなら、Sheets プロパティの利用は避け、
シートの種類(ワークシート、グラフ、ダイアログ、マクロシート)ごとに
.Worksheets / .Charts / .DialogSheets / .Excel4MacroSheets プロパティを
使い分けるようにしましょう。


>  If xlSheet.Cells(29, 51) = Empty Then  'Ppk管理図ファイルのセル(29行, 51列)が空の場合
Empty 値の判定に = 演算子を使うことはできません。= 演算子を使って調べてしまうと、たとえば、
そのセルが「=3-2-1」すなわち 0 だった場合にも空セルと誤判定されてしまうことになります。

Empty 値の判定には、VarType 関数または IsEmpty 関数を用いるようにしましょう。
 If IsEmpty(xlSheet.Cells(29, 51).Value) Then


>     xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(0, 1) = Now               '月
>     xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(1, 0) = Now               '日
>     xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(2, 0) = P_p_k             'Ppk
Selection プロパティや Active 系プロパティの利用はできるだけ避けてください。
(多用すると、コードの意図が曖昧になってしまいます)

ActiveWorkbook プロパティと同様に、ActiveSheet プロパティの出番も無いはずです。
先ほど、L_Value のシートを Select したわけですから、その時のシートを明示すれば済みますよね。


また、End プロパティを繰り返し使っていますが、データ入力に応じて終端位置は変動しますので、
このようなコードを多用すると、どの位置に記入しているのかが分かりにくくなる可能性があります。
基準位置となるセルを変数に保持しておいた方が、コードがスッキリすると思いますよ。

 Set rng = xlSheet.Cells(29, xlSheet.Columns.Count).End(xlToLeft)

 rng.Offset(0, 1).Value = Now
 rng.Offset(1, 1).Value = Now
 rng.Offset(2, 1).Value = P_p_k


>  Dim fsoFolExi As New FileSystemObject
>  Dim fsoFolCop As New FileSystemObject
>  Dim fsoFilCop As New FileSystemObject
VB6 の場合、宣言時に New を組み込むのは避けた方が良いでしょう。
また、FileSystemObject のインスタンスは 1 つあれば十分のハズです。
 Dim fso As FileSystemObject
 Set fso = New FileSystemObject


>  If fsoFolExi.FolderExists(strPpkFolNam_Path) <> "true" Then
FolderExists の戻り値は Boolean 型です。String と比較すべきではありません。
処理結果としては同じ事ですが、この場合には
 If Not fsoFolExi.FolderExists(strPpkFolNam_Path) Then
もしくは
 If fsoFolExi.FolderExists(strPpkFolNam_Path) = False Then
の方が適切かと。


>     fsoFolCop.CopyFolder "\\Kq-001\工程集計\原紙ファイル\Ppk管理図(原紙)", _
>                          "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\"      
>     Name "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\" & "\Ppk管理図(原紙)" _
>       As "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\" & "\Ppk管理図" & Gouki
間違いではありませんが、この部分、やや統一性が無いように見えました。

コピーは FileSystemObject で行っているのに、名前変更は FileSystemObject を使わず、
Name ステートメントを使っていますね。Name プロパティを使った方が良いのではないでしょうか。


> どなたかご教授いただけませんでしょうか。
http://www.tt.rim.or.jp/~rudyard/torii009.html

[ツリー表示へ]
タイトルRe^2: Excelが解放されない
記事No14809
投稿日: 2010/07/09(Fri) 10:54
投稿者rgnoo
魔界の仮面弁士さん、早速のご回答ありがとうございます。
ご指摘頂きました部分のコードを作り直し、動作確認したいと思います。

さて、ご指摘頂きました内容でわからない所がありました。
教えていただけませんでしょうか。

> >  Set xlSheet = xlBook.Worksheets(L_Value)
> >  xlBook.Sheets(L_Value).Select '対象L値のシート選択
> L_Value というのが、シート名を表す文字列なのか、シート番号を示す自然数なのか
> 読み取れませんでしたが、恐らく、ここでいう xlBook.Worksheets(L_Value) と
> xlBook.Sheets(L_Value) は、同じシートを表しているのですよね?
>
> 同じシートならば、最初に取得した xlSheet 変数を使って制御するようにすべきです。

はい。同じシートをしめしております。
申し訳ございません。「xlSheet 変数を使って制御する」というのは、
Set xlSheet = xlBook.Worksheets(L_Value)だけで、シートの選択はできており、
このコードのみでよいということでしょうか?

> >     fsoFolCop.CopyFolder "\\Kq-001\工程集計\原紙ファイル\Ppk管理図(原紙)", _
> >                          "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\"      
> >     Name "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\" & "\Ppk管理図(原紙)" _
> >       As "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\" & "\Ppk管理図" & Gouki
> 間違いではありませんが、この部分、やや統一性が無いように見えました。
>
> コピーは FileSystemObject で行っているのに、名前変更は FileSystemObject を使わず、
> Name ステートメントを使っていますね。Name プロパティを使った方が良いのではないでしょうか。

申し分けございません。
Name プロパティを使ったコードはどのようになるのか教えて頂けませんでしょうか。

お忙しい所誠に恐縮ですが、以上よろしくお願い致します。

[ツリー表示へ]
タイトルRe^3: Excelが解放されない
記事No14810
投稿日: 2010/07/09(Fri) 13:04
投稿者魔界の仮面弁士
> 「xlSheet 変数を使って制御する」というのは、
> Set xlSheet = xlBook.Worksheets(L_Value)だけで、シートの選択はできており、
> このコードのみでよいということでしょうか?
取得しただけなので、選択はされていません。

xlBook.Sheets(L_Value).Select ではなく、
xlSheet.Select と記述しましょう、という意味です。


> ご指摘頂きました内容でわからない所がありました。
指摘の意図を順に説明していきます:



★1:シート系プロパティを使い分けましょう★

>> シートの種類(ワークシート、グラフ、ダイアログ、マクロシート)ごとに
>> .Worksheets / .Charts / .DialogSheets / .Excel4MacroSheets プロパティを
>> 使い分けるようにしましょう。

Excel のシートには、ワークシートやグラフシートなど、複数の種類があります。

たとえば、「シートの種類は問わないが、とにかく先頭のシート」という目的であれば、
xlBook.Sheets(1) といった表現で構いませんが、「先頭のワークシート」の意味ならば
xlBook.Worksheets(1) と記述した方が、より正確な表現となります。
(シート番号ではなく、シート名などを使うとよりベター)

また、もしもワークシートしか使っていない場合には、
 xlBook.Sheets(L_Value).Select
 xlBook.Worksheets(L_Value).Select
は同じ意味を持ちますが、他の種類のシートなどが含まれていると、
それぞれは別のシートを指し示す可能性があります。


★2:プロパティの取得回数は最低限にしましょう★

>> 同じシートならば、最初に取得した xlSheet 変数を使って制御するようにすべきです。

xlBook.Sheets(L_Value).Select を実行したときには、

 (1) xlBook 変数から、処理対象の Workbook オブジェクトを取得。
 (2) Workbook オブジェクトの Sheets プロパティから、Sheets オブジェクトを取得。
 (3) Sheets オブジェクトの既定のプロパティから、L_Value という
  Sheet オブジェクト(正確には Worksheet オブジェクト)を取得。
 (4) Sheet オブジェクトの Select メソッドを呼び出し、該当シートを選択。

という処理が実行されています。L_Value に対して検索処理が発生しています。

しかし処理対象のワークシートは、既に変数 xlSheet に取得済みなのですから、
ここでは xlSheet.Select と記述した方がスマートです。こちらの記述を使うと、

 (1) xlSheet 変数から、処理対象の Worksheet オブジェクトを取得。
 (2) Worksheet オブジェクトの Select メソッドを呼び出し、該当シートを選択。

という単純なステップで済みます。



>>     Name "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\" & "\Ppk管理図(原紙)" _
>>       As "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\" & "\Ppk管理図" & Gouki
> 間違いではありませんが、この部分、やや統一性が無いように見えました。
よく見ると微妙に間違っていますね。これだと、
 "\\Kq-001\工程集計\工程不良集計\Ppk集計\Ppk管理図(原紙)"
ではなく
 "\\Kq-001\工程集計\工程不良集計\Ppk集計\\Ppk管理図(原紙)"
というパスを操作していることになってしまいます。


> Name プロパティを使ったコードはどのようになるのか教えて頂けませんでしょうか。
"Ppk管理図(原紙)" というのはフォルダですよね。
Gouki が文字列であり、かつ、その中に "\" が含まれていないというパターンなら、
  FSO.GetFolder("\\Kq-001\工程集計\工程不良集計\Ppk集計\Ppk管理図(原紙)").Name = "Ppk管理図" & Gouki
といった感じです。ここで、FSO はFileSystemObject 型のオブジェクト変数です。

あるいは、
  FSO.MoveFolder "\\Kq-001\工程集計\工程不良集計\Ppk集計\Ppk管理図(原紙)", _
                 "\\Kq-001\工程集計\工程不良集計\Ppk集計\Ppk管理図" & Gouki
という書き方もできます。

[ツリー表示へ]
タイトル蛇足情報
記事No14811
投稿日: 2010/07/09(Fri) 13:06
投稿者魔界の仮面弁士
> ★2:プロパティの取得回数は最低限にしましょう★
今回はシートを例に取りましたが、他のオブジェクトであっても同様です。

たとえば、先のコードでいえば
>> xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(3, 0) = Average
なども、できれば見直しておいた方が良いでしょう。

VB6 から Excel を操作する場合、別のプロセスに対する操作を行うことになるため、
その操作はやや低速なものとなってしまいます。

そのため一般的には、
 ・「1 行挿入」を X 回繰り返す。
よりも
 ・「X 行挿入」を 1 回行う。
方が、Excel との通信回数が減る分、処理効率が良くなります。


たとえば下記のようにして、1000 個のデータを書き込んでみた場合、
当方では平均 3.0 秒という時間を要しました。
ユーザーにとってみれば、秒単位の待ち時間というのは比較的低速な処理であり、
実行すると、Excel のスクロールバーがだんだんと延びていく様子が見えます。

    Dim t As Single
    t = Timer

    Dim row As Integer
    For row = 1 To 500
        'Value プロパティへの代入操作が、計 1000 回行われている。
        xlSheet.Cells(row, 1).Value = 10000 + row
        xlSheet.Cells(row, 2).Value = 20000 + row
    Next

    Debug.Print "処理時間:"; Timer - t


上記の「xlSheet.Cells(row, 1).Value = 10000 + row」というコードでは、
Cells プロパティを利用しているわけですが、実は Cells プロパティというのは
「引数の無いプロパティ」なのです。一見、引数が指定されているように見えますが、実は
「xlSheet.Cells.Item(row, 1).Value = 10000 + row」という操作が行われています。

※ 正確には .Item ではなく .[_Default]


すなわち「xlSheet.Cells(row, 1).Value」というコードでは、

 (1) Worksheet オブジェクトの Cells プロパティから、
  シート内の全てのセルを表す巨大な Range オブジェクトを得る。

 (2) Range オブジェクトの既定のプロパティから、row 行目 1列目のセルを
  単一セルを表す Range オブジェクトを得る。

 (3) Range オブジェクトの Value プロパティにデータを割り当てる。

という手順が発生しており、それを都合 1000 回繰り返していたというわけです。


この場合、オブジェクトの操作方法を工夫することで処理速度が向上します。
先のコードでは、3.0 秒でしたが、下記のコードだと 1.5 秒にまで半減しました。

    Dim t As Single
    t = Timer

    Set xlRange = xlSheet.Range("A1:B1")   '基準位置となる 2セル分だけ取得

    Dim row As Integer
    For row = 1 To 500
        '2 セルずつ操作する事で、Value への書き込み回数を半分に減らす。
        xlRange.Value = Array(10000 + row, 20000 + row)  '1 次元配列を渡す
        Set xlRange = xlRange.Offset(1)                  '下に1行ずらす
    Next

    Debug.Print "処理時間:"; Timer - t


さらに手を加えて、Value への書き込みを 1 回だけにしてやれば、
ほぼ一瞬(0.1 秒未満)で処理を完了させることもできます。

    Dim t As Single
    t = Timer

    Set xlRange = xlSheet.Range("A1:B500")

    Dim data() As Variant
    data = xlRange.Value   '500行×2列 の 2次元配列を得る。

    Dim row As Integer
    For row = 1 To 500
        'ローカル配列への代入なので、この処理は非常に高速に行われる。
        data(row, 1) = 10000 + row
        data(row, 2) = 10000 + row
    Next

    'Value プロパティへの代入操作は、この 1 回だけで済む。
    xlRange.Value = data

    Debug.Print "処理時間:"; Timer - t


なお無駄なオブジェクト操作は、速度低下を招くだけでなく、環境によっては
ハングアップの要因となる可能性もありますのでご注意ください。
http://support.microsoft.com/kb/414107/ja
(とはいえ、最近の環境であればハングアップまではしないと思いますが)

[ツリー表示へ]
タイトルRe^4: Excelが解放されない
記事No14812
投稿日: 2010/07/09(Fri) 16:25
投稿者rgnoo
魔界の仮面弁士さん、早速のご回答ありがとうございます。
ご指摘頂きました部分のコードを作り直しましたが、弊社の都合上、本日、
動作確認ができない状況です。
12日に動作確認をしたいと思います。結果をまたご報告致します。
また、蛇足情報でもいろいろと為になることを教えていただき、誠にありがとうございます。
とても勉強になりました。
エクセルの解放がうまくいくことを願っておりますが、万が一失敗した時には、
またアドバイスよろしくお願い致します。

[ツリー表示へ]
タイトル【解決】Re^5: Excelが解放されない
記事No14817
投稿日: 2010/07/13(Tue) 15:00
投稿者rgnoo
魔界の仮面弁士さん、お返事が大変遅くなり誠に申し訳ございません。
本日、やっと動作確認ができました。
おかげさまで、エクセルの解放に成功致しました。
今回は、細かいところまでいろいろとアドバイスを頂き、本当にありがとうございました。
助けていただき本当に感謝しております。
また、何か困ったことがあった際には、アドバイスを頂けたら嬉しく思います。
本当にありがとうございました。

[ツリー表示へ]