アプリ版:「スタンプのみでお礼する」機能のリリースについて

下記を行いたかったのですが上手く動作しませんでした。
理由がわかるかたがいらっしゃいましたらご教示をお願いします。

# 本来行いたかったことは別の方法で実現したので、質問は後学のためです。


※行いたかったこと
・マクロで、開いているブック(以下xlsmファイル、シートは1個のみ)タブ区切り形式で保存する
・保存したファイル(以下txtファイル)の拡張子がtxtなのでtsv(以下tsvファイル)に変更したい

※問題点
・ThisWorkbook.SaveAs FileFormat:=xlText で保存するとtxtファイルがThisWorkbookとなってしまう
・txtファイルを開いている状態なのでtsvに拡張子変更ができない

※対応策(上手くいかなかった)
・ThisWorkbook.SaveAsで保存後、xlsmファイルを開き、txtファイルを閉じる
・txtファイルのWorkbook_Openイベントで、txtファイルが閉じたことを確認後
 txt→tsvのリネームを行う

※結果(状況)
・saveAsTSV()を実行するとtxtファイル保存はされるが、tsvファイルへのリネームが行われない
 "TXT close"メッセージは表示されている
 既にtsvファイルが存在している場合、削除(上書き)されない

・xlsmファイルとtxtファイルが存在する状態で、xlsmファイルを起動すると
 txt→tsvのリネームは行われる。


実験環境
Win7 32bit / Excel 2010
Win10 64bit / Excel 2016



-------------------------------------------------------
Option Explicit

Public Sub saveAsTSV()
  Dim xlsmPath As String
  Dim txtPath As String
  
  xlsmPath = ThisWorkbook.FullName
  txtPath = Left(xlsmPath, InStrRev(xlsmPath, ".")) & "txt"
  
  ThisWorkbook.SaveAs Filename:=txtPath, FileFormat:=xlText, CreateBackup:=False
MsgBox ThisWorkbook.Name
  
  Workbooks.Open xlsmPath
  ThisWorkbook.Close
  
End Sub


-------------------------------------------------------
Option Explicit

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub Workbook_Open()
  Dim bk As Workbook
  Dim xlsmPath As String
  Dim txtPath As String
  Dim tsvPath As String
  Dim flag As Boolean
  
  xlsmPath = ThisWorkbook.FullName
  txtPath = Left(xlsmPath, InStrRev(xlsmPath, ".")) & "txt"
  tsvPath = Left(xlsmPath, InStrRev(xlsmPath, ".")) & "tsv"

  ' TXTが開いていたら閉じる
  For Each bk In Workbooks
    If bk.FullName = txtPath Then
MsgBox "TXT close"
      bk.Close SaveChanges:=True
    End If
  Next
  ' TXTが閉じるまで待つ
  flag = True
  Do While flag
    flag = False
    For Each bk In Workbooks
      If bk.FullName = txtPath Then flag = True
    Next
    Sleep 100
    DoEvents
  Loop
  Sleep 100
  
  With CreateObject("Scripting.FileSystemObject")
    ' TXTがあればTSVにリネーム
    If .FileExists(txtPath) Then
      ' TSVがあれば削除
      If .FileExists(tsvPath) Then
MsgBox "Delete"
        .deleteFile tsvPath
      End If
MsgBox "Rename"
      .moveFile txtPath, tsvPath
    End If
  End With

End Sub

質問者からの補足コメント

  • > ・txtファイルのWorkbook_Openイベントで、txtファイルが閉じたことを確認後
     txt→tsvのリネームを行う

    txtファイルのWorkbook_Openイベント

    xlsmファイルのWorkbook_Openイベント

    です。

      補足日時:2017/02/04 08:06
  • ご回答ありがとうございます。
    ただ、質問の趣旨は目的の実現ではなく、記載した方法が何故うまくいかないのかの原因を知りたいことにあります。
    原因についてご存知のことがありましたら、再度のご回答をいただけますと幸いです。

    No.1の回答に寄せられた補足コメントです。 補足日時:2017/02/04 11:19

A 回答 (9件)

こんなやり方はいかがでしょうか?


①「ActiveSheet.Copy」でシートのコピーを作成し、タブ区切り形式で保存する
② コピーしたシートを「ActiveWindow.Close」で閉じる
③ リネームする。
この回答への補足あり
    • good
    • 0

多分としか言えませんがキャッシュのような状態で残ってしまっているのではないでしょうか?エクセル本体をアンロードするか、他にキャッシュが必要になってキャッシュがクリアされるまではダメなのかもしれません。

    • good
    • 0

こんにちは。



私には、仕様に関しては、あまり考えないことにしています。理由は、人が作っているからです。ただ、Excel等のファイルの構造上、キャッシュの中にあるし、そのファイルは排他的な状態(仕様)ですから、そのオブジェクトの範囲以上の加工するのは無理でしょう。それは言うまでもないと思いますが。

それと、なぜうまく行かなかったかという答えをさせられるよりも、自分の能力の範囲で、目的にかなったものを作れるかどうかしか、私は興味はありません。

#1さんの書き込みの内容をコードにしてみました。なお、このスタイルは、かなり古典的です。範囲を出力する場合は、一旦、セルの範囲のコピーが必要です。
'//
Public Sub saveAsTSV2()
  Dim xlsmPath As String
  Dim txtPath As String
  Dim tsvPath As String
  Dim newBk As Workbook
 
  xlsmPath = ThisWorkbook.FullName
  txtPath = Left(xlsmPath, InStrRev(xlsmPath, ".")) & "txt"
  tsvPath = Left(xlsmPath, InStrRev(xlsmPath, ".")) & "tsv"
  ActiveSheet.Copy
  Set newBk = ActiveWorkbook
  On Error Resume Next
  If Dir(txtPath) <> "" Then Kill txtPath
  If Dir(tsvPath) <> "" Then Kill tsvPath
  On Error GoTo 0
  With newBk
   .SaveAs Filename:=txtPath, FileFormat:=xlText
   .Close False
  End With
  Name txtPath As tsvPath
  
  If Dir(tsvPath) <> "" Then
    MsgBox "Success: " & tsvPath
  Else
    MsgBox "Failure", vbExclamation
  End If
End Sub
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます、いろいろな意味で参考になります。
一点気になったのですが

> #1さんの書き込みの内容をコードにしてみました。なお、このスタイルは、かなり古典的です。

もっと今風?な方法があるのでしょうか?
もしありましたら、ご指南いただけると嬉しいです。

お礼日時:2017/02/04 17:07

こんばんは。



>>このスタイルは、かなり古典的です。
>もっと今風?な方法があるのでしょうか?

聞くまでもないのではありませんか(^^;
今も昔も、マクロを一通り知っている人は、以下のようなOpen ステートメントを書くのが、定番なのではないでしょうか。

このように書いていた人にとって、#3で書いたようなコードを見せられると、結構、新鮮で関心してしまうものなのです。

'//
Public Sub TsvExport()
 Dim fNo As Integer
 Dim xlsmPath As String
 Dim txtPath As String
 Dim tsvPath As String
 Dim rng As Range
 Dim ar, buf, i As Long
 xlsmPath = ThisWorkbook.FullName
 tsvPath = Left(xlsmPath, InStrRev(xlsmPath, ".") - 1) & ".tsv"
 Set rng = ActiveSheet.UsedRange
 
 fNo = FreeFile()
 Open tsvPath For Output Access Write As #fNo  '上書きモード
 For i = 1 To rng.Rows.Count
  ar = WorksheetFunction.Index(rng.Rows(i).Value, 1, 0)
  buf = Join(ar, vbTab)
  Print #fNo, buf
  buf = ""
 Next i
 Close #fNo
 If Dir(tsvPath) <> "" Then
  MsgBox "Success: " & tsvPath
 Else
  MsgBox "Failure!"
 End If
End Sub
'//

今どきというと、文字コードを変える話が、この後に出てきます。UTF-8 だとか、Unicodeとか。

一ヶ所、このように変えました。
Left(xlsmPath, InStrRev(xlsmPath, ".") - 1) & ".tsv"
BaseFileName に、"U" とか、識別させるイニシャルを入れるようにするためです。

WorksheetFunction.Indexは、巨大なファイルは入らないはずです。
    • good
    • 0
この回答へのお礼

再度のご回答ありがとうございました。

> 聞くまでもないのではありませんか(^^;

申し訳ありませんが、聞いてみないと回答者様がどのようにお考えなのか確認できないので、そのとおりさせて頂きました。回答者様の他の質問への回答も鑑みますと、回答者様はVBAに関して、かなり造詣が深いようですので私が思いつかない方法が存在するのかとも考えてしまいました。結果としてその方法は、私が質問で書いた別解と同じ方法でしたが……
できましたらNo.3の段階で、もってまわった表現をされずに今回の内容を記載いただけば良かったとも思います。
とまれ、疑問点が解消しましてスッキリしました、ありがとうございました。


# 本来の質問について、他の方の意見もお聞きしたいので、しばらくクローズせずに置きます。

お礼日時:2017/02/04 19:23

直接の回答ではありませんがテキストファイルが完全にエクセルの管理下から外れたかどうかを調べるようなものがありました。

ご参考にどうぞ!
http://www.moug.net/tech/exvba/0060012.html
    • good
    • 0
この回答へのお礼

何度もご回答いただきまして恐縮です。
ご提示のリンク先の方法は、私がおこなった方法とほぼ一緒ですね(.Nameか.FullNameの違い)
閉じたことの確認方法は、このやり方で良かったことがわかりました、ありがとうございます。

となると質問した内容がうまくいかないのは、やはりキャッシュ云々ということになるのでしょうかね。

# もう少し情報を頂きたいので暫くクローズせずに置きます。

お礼日時:2017/02/05 06:49

予想ですが。



ThisWorkbook.Close の実行と、実際にファイルが閉じられるタイミングが違うのではないでしょうか。


マクロ実行開始

元ファイルのマクロモジュール読み込み

saveAsTSV 実行

新ファイルをオープン
saveAsTSV実行中なので、Workbook_Openはここでは実行されない

ThisWorkbook.Close する
「元ファイルのマクロモジュール」が使用中のため、完全に閉じるのはこの段階ではない

saveAsTSVのEnd Subへ到達

新ファイルのWorkbook_Openを実行
元ファイルはマクロモジュールが使用中のため、ファイル名を変更できない

全マクロ終了

読み込んでいたマクロモジュールを解放

元ファイルが全て未使用になったので、ここでファイルが閉じられる。

と考えると、説明が付きます。
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます。
このカテゴリでご回答を頂いたことに少々驚いております。

「元ファイル」「新ファイル」が何を指しているのかがわかりにくいのですが

「元ファイルのマクロモジュール」いうのは一番最初に起動して(saveAsTsvが実行される)xlsmファイルのマクロモジュールということで良いですよね?
このマクロモジュールがtxtファイルを使用中(アクセス件を持っている?)の間は、リネームできないというのはわかります。
saveAsTsv内でWorkbook_Openで起動されるマクロ(モジュール?)は、メッセージ"TXT close"が表示されていることで実行されていることは確認できます。
そして、このWorkbook_Openで起動されたマクロがtxtファイルのリネームを行おうとするが、「元ファイルのマクロモジュール」がtxtファイルを使用中のため、リネームできない。


要するに
「元ファイルのマクロモジュール」は一旦起動?するとアプリケーションとしてのExcelを終了するまで、たとえマクロの実行が終了しても、握った権利を手放さないということですね。
もしそうだとすると挙動は理解できます。

お礼日時:2017/02/05 18:08

もしかしたらですが、元をこちらで試していなかったので気づかなかったのですが確認していただいて良いですか?


コードはコピペされたもので手入力はされていませんよね。
「.deleteFile tsvPath」→「.DeleteFile tsvPath」
「.moveFile txtPath, tsvPath」→「.MoveFile txtPath, tsvPath」
にそれぞれなっていないので「.deleteFile」と「.moveFile」がメゾットとして存在していないのでは?
それぞれ「Kill」と「Name」ステートメントを使ったらどうなりますか?
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます。

> 「.deleteFile」と「.moveFile」がメゾットとして存在していないのでは?

確か大文字/小文字の区別はなかったかと思います。
質問でも書きしたがtxtがある状態での起動時にリネームは実行されております。
念のため、メソッド名修正、コマンドの変更を行いましたが結果は同じでした。

ちなみにVBAのコマンドではなくFileSystemObjectを使用しているのは、対象のファイルが共有サーバ上にあるからです。少なくともファイル存在確認で使用するDirコマンドがネット上パスのファイルに対して正常動作しないことは経験済みでしたので、この様にしました。

お礼日時:2017/02/05 17:44

#4の回答者です。



言葉の足らない部分、読み落としについては大変に失礼しました。
今後の教訓にさせていただきます。

>記載した方法が何故うまくいかないのかの原因を知りたい
とはいうものの、saveAsTSV() で、もう一つ手を加えれば、そのような問題には直面しないと思いました。もし正解のコードが分かっていて、それで、その2つのコードを対比してみて、どうしてこうなるのかということなら、事情は理解できたかと思います。しかし、仕様の問題になると、それはなかなか簡単に答えられるものではありません。

だから、私としては、コードをみていただいたほうが早いのだと思いました。

ただ、以下のようなこは、ふつう書きません。なぜなら、結果オーライで済ませてしまうからです。

表現がこなれていませんが、
「Excelを起動すれば、仮想のキャッシュが設けられ、そこでファイルが展開されます。そこにあるものに関しては、Excel のアプリのオブジェクトの範囲での処理は可能ですが、Excelアプリの管理下では、その領分を越えたら、あくまでもExcelのアプリに関しては、自由にはならない」ということです。

これは、いわゆる排他的ロックと同じことだと思います。Excelにかぎらず、以下のコードで、それは判断することが可能で、ロックがかかっているかどうかを調べるためのものです。Word Docでも同様に調べられます。

Sub TestOpenFileCheck1()
Dim FName As String
Dim fNo As Integer
FName = ThisWorkbook.FullName
On Error Resume Next
If Dir(FName) <> "" Then
fNo = FreeFile
Open FName For Binary Lock Read Write As #fNo
Close #fNo
Else
 MsgBox FName & "は見つかりません。"
End If
 If Err.Number = 70 Then
  MsgBox "ファイルは開いています", 16
 ElseIf Err.Number = 0 Then
  MsgBox "ファイルは編集できます。", 64
 Else
  MsgBox "ファイルを調べてください", 32
 End If
 On Error GoTo 0
End Sub
    • good
    • 0
この回答へのお礼

最初の質問と関係ないやりとりはあまり行いたくないのですが

> 今後の教訓にさせていただきます。

とのことでありますので敢えて書きます。
回答者様に対して大変失礼な物言いとなりますので、お気に障られましたら若輩者の戯言とお考え下さい。

回答者様のいろいろな回答を拝見しまして感じていた違和感が2点あります。


1.質問の趣旨と関係ない自分語りが多い

例えば、No.3のご回答において、最初と、その次の段落の内容は必要でしょうか?
また最後の段落の内容は、No.1さんへのレスになっています。
これでは、「質問に対する回答」ではなく、「回答したいからの回答」になってしまいます。


あとVB6やBASP21についての知識のご披露は、使用環境の制限などで、必ずしも質問者の参考になるものではないことをご配慮いただけると嬉しいです。



2.欲しい回答から、ずれた内容を回答される。
 少なくともNo.1さんへの補足を行った後でこの内容はあり得ません。

> とはいうものの、saveAsTSV() で、もう一つ手を加えれば、そのような問題には直面しないと思いました。

「もう一つ手を加えた」コードはどこで回答されていますか?
もしかしてNo.3のコードのことでしょうか?

(補足に書きましたとおり、今回の質問は「問題解決型」ではなく「原因究明型」です。
 このカテゴリでは前者の質問が殆どですので、仕方がないのかもしれませんね)


> 私としては、コードをみていただいたほうが早いのだと思いました。

No.1さんの内容をコードにしたものから質問の回答として何が得られますか?
あるいは何かを得るための前提の説明がなさすぎるのかもしれません。


> しかし、仕様の問題になると、それはなかなか簡単に答えられるものではありません。

こう言ってはお終いかもしれませんが、わからないことに対して敢えてご回答いただく必要はありません。



先にも書きましたが、質問者様のVB関係への造詣の深さは敬服に値します。
なので一層「シンプルな回答者」になっていただくことを望む次第であります。

お礼日時:2017/02/07 05:40

No.7 に付いてです。



大変申し訳ございませんでした。VBAの標準のメゾットの場合小文字で入力してもエディタが勝手に頭文字を大文字に変える(登録メゾット名に変えられるので途中も大文字になるものも有ります)が働いていないので間違っていないかと思ったわけです。
ご足労かけて申し訳ございませんでした
    • good
    • 0
この回答へのお礼

いえいえ、いろいろご検討いただいて感謝しております。

外部のオブジェクトを使用していると、メッソドの候補リストが自動で現れないことはよくあります。
その様な場合は、メソッド名を手入力しなければならないので不便ですよね。

お礼日時:2017/02/05 18:16

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