毎日送られてくるデータをエクセルに自動的に入力できませんか？

いつもお世話になっております。
皆さんのお知恵を拝借したく、質問させていただきます。
毎日他の１施設から次のデータが送られてくるとします。
A 　　　 　　　B 　　　　　　 C
1 4/1 　　　　　　　　　　　 ←日にち
2　甲　　　　乙　　　　　　　 丙　　　 ←品目
3 100 　　　 200 　　　　 300
4 200　　　　　400 　　　　 600
5 300 　　　 600 　　　　 900

実は電子メールで送付されてくるデータをエクセルで次のように集計していたとします。

A 　　　　B 　　 　 C 　　　 D
1 　　　　甲　　　　　 乙　　　　　　丙
2 4/1　　　　　600 　　　1,200 　　　 1,800　　　←合計値等
3 4/2 　　　 . 　　　 . 　　　 .
4 4/3 　　　 . 　　　 . 　　　 .
5 4/4 　　　 . 　　　 . 　　　 .

と、各日の合計値等を入れたいのですが、なんとか毎日送られてくるデータを自動的に取り込む方法はないでしょうか？送付データも集計データもエクセルで、送付データは"20080401"などの日付で送られてきます。これは変更しても構いません。送付データの様式はいつも一定で、数値の個数は毎回違っています。
　表の数値がずれてしまい、見ずらくてすみません・・・

よろしくお願いいたします。

No.4 ベストアンサー 回答者： hotosys 回答日時： 2008/06/11 10:03

>実はこの集計データは月別にシーツが分かれています。

データを開いて調べてから対象シートを設定する必要があるので、以下のようになる。
シート名の月が半角の場合と全角の場合(４月と4月)があるので、どちらかを有効にする。

Sub sample()
Dim ws As Worksheet
Dim file As Variant
Dim r As Long
Dim c As Long
'ChDir ThisWorkbook.Path '[ファイルを開く]ダイアログボックスの最初のフォルダをこのブックと同じフォルダに（以下に各種フォルダの場合）
'ChDir "c:\" '指定パス
'ChDir CreateObject("WScript.Shell").SpecialFolders("MyDocuments") 'マイ ドキュメント
'ChDir CreateObject("WScript.Shell").SpecialFolders("Desktop") 'デスクトップ
file = Application.GetOpenFilename("Microsoft Excelブック,*.xls")
If file = False Then Exit Sub

Application.ScreenUpdating = False
With Workbooks.Open(file)
With .Sheets(1) 'データのあるシートは先頭のシートの場合
'With .ActiveSheet 'データのあるシートはアクティブシートの場合

'Set ws = ThisWorkbook.Sheets(Month(.Range("A1")) & "月") '月が半角の場合
Set ws = ThisWorkbook.Sheets(StrConv(Month(.Range("A1")), vbWide) & "月") '月が全角の場合
r = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
c = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

.Range("A1").Copy Destination:=ws.Cells(r, 1)
ws.Range(ws.Cells(r, 2), ws.Cells(r, c)).Formula = "=SUM([" & .Parent.Name & "]" & .Name & "!A3:A" & .Rows.Count & ")"
End With
ws.Range(ws.Cells(r, 2), ws.Cells(r, c)).Copy
ws.Range(ws.Cells(r, 2), ws.Cells(r, c)).PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Close
End With
Application.ScreenUpdating = True
End Sub

この回答へのお礼

返答ありがとうございます！
本当に参考になりました。

お礼日時：2008/06/11 19:02

No.3 回答者： hallo-2007 回答日時： 2008/06/10 18:32

No1です。

VBAをご存知のようなので、MS－OUTLOOKに入れるVBAをひとつ紹介しておきます。
OUTLOOKのVBエディター開いて以下、コピィしてみてください。
メールを受信添付ファイルを保存、確認のメールを返信までが自動になります。
準備として
受信の際に、データのメールの場合は、件名、或いは送信者名なので
そのメールのみ　別のトレイへ移動するように自動仕訳のウィザードで
設定しておきます。

以下では、データのメール受信されると　データフォルダ　というフォルダを作成し移動する設定の場合です。
データフォルダのメールを参照して、添付ファイル名が
新規データ.xls の場合は　A:へ保存してお礼のメールを返信します。
動作確認はしていませんが、VBAを順に確認してもらうと流れがわかるかと思います。
全てが必要ではないと思いますが、そちらの状況に合わせて設定してみてください。

Private Sub Application_NewMail()　'新規メール受信時のイベント
Dim myItem As Outlook.MailItem ' MailItemオブジェクト
Dim myFolder As Outlook.MAPIFolder ' MAPIFolderオブジェクト
Dim myNameSpace As Outlook.NameSpace ' NameSpaceオブジェクト

' NameSpaceオブジェクトの取得
Set myNameSpace = Application.GetNamespace("MAPI")

' 「受信トレイ」のオブジェクトを取得
Set myMailFolder = myNameSpace.GetDefaultFolder(olFolderInbox)

' 「データフォルダ」というサブトレイのオブジェクトを取得
Set myFolder = myMailFolder.Folders("データフォルダ")

' 「データフォルダ」フォルダ内のすべてのアイテム数ループ
For i = 1 To myFolder.Items.Count
' MailItemオブジェクトを取得
Set myItem = myFolder.Items(i)

' 未読のメールのみに処理を行なう
If myItem.UnRead = True Then
'　添付ファイルを保存
Set myAttachments = myItem.Attachments
c = myItem.Attachments.Count
For CLE = 1 To c
If myAttachments.Item(CLE).DisplayName = "新規データ.xls" Then
　　　　　　'サンプルでは、添付ファイル名が新規データの名前の場合です。
myAttachments.Item(CLE).SaveAsFile "A:\" & myAttachments.Item(CLE).DisplayName
'サンプルではA:\に保存です。
MsgBox("新しいデータを保存しました", vbOKOnly, "データ保存")
' 返信用オブジェクトを作成
Set myReply = myItem.Reply
' 件名と本文を設定
myReply.Subject = "データを受け取りました"
myReply.Body = "本日のデータ、確かに受け取りました。ありがとうございます"
' 返信を送信
myReply.Send
End If
Next
' メッセージを既読に設定
myItem.UnRead = False
End If
Next i
End Sub

この回答へのお礼

返答ありがとうございます。
色々おしえていただき参考になりました。
マクロだと色々できてもっと勉強していきたいと思っております。

お礼日時：2008/06/11 19:04

No.2 回答者： hotosys 回答日時： 2008/06/07 18:24

送付されてくるデータのあるフォルダとシート名、集計するシート名など不明な点があるので、必要に応じて修正して下さい。

Sub sample()
Dim ws As Worksheet
Dim file As Variant
Dim r As Long
Dim c As Long
ChDir ThisWorkbook.Path '[ファイルを開く]ダイアログボックスの最初のフォルダをこのブックと同じフォルダに（以下に各種フォルダの場合）
'ChDir "c:\" '指定パス
'ChDir CreateObject("WScript.Shell").SpecialFolders("MyDocuments") 'マイ ドキュメント
'ChDir CreateObject("WScript.Shell").SpecialFolders("Desktop") 'デスクトップ
file = Application.GetOpenFilename("Microsoft Excelブック,*.xls")
If file = False Then Exit Sub
Set ws = ThisWorkbook.Sheets("Sheet1") '集計するシート名を指定
'Set ws = ThisWorkbook.ActiveSheet '集計するシートは現在のシート
r = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
c = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
With Workbooks.Open(file)
With .Sheets(1) 'データのあるシートは先頭のシートの場合
'With .ActiveSheet 'データのあるシートはアクティブシートの場合
.Range("A1").Copy Destination:=ws.Cells(r, 1)
ws.Range(ws.Cells(r, 2), ws.Cells(r, c)).Formula = "=SUM([" & .Parent.Name & "]" & .Name & "!A3:A" & .Rows.Count & ")"
End With
ws.Range(ws.Cells(r, 2), ws.Cells(r, c)).Copy
ws.Range(ws.Cells(r, 2), ws.Cells(r, c)).PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Close
End With
Application.ScreenUpdating = True
End Sub

この回答への補足

教えていただきありがとうございます。返事遅れてすみませんでした。実はさらに教えていただきたいことがあるのですが、実はこの集計データは月別にシーツが分かれています。「４月」の集計シート、「５月」の集計シートと言う感じでです。そういう場合はさらにVBAも複雑になるのでしょうか？私なりにArrayを使うのかな・・・と考えて色々入れてみたのですがなかなか上手くいきませんでした。教えていただければ幸いです。

補足日時：2008/06/09 18:01

No.1 回答者： hallo-2007 回答日時： 2008/06/07 12:58

作業の流れを以下のように考えるとシンプルかと思います。

１、送られてくるデータを日次データ　とでもします（ファイル名は固定でよいでしょう）
２、日次データ　以下のようにしておきます。
　　A　　　B　　C　　D
1 日付　担当　品名　数量
2　4/1 　Ａ 　甲　　100
3　4/1 　Ｂ　　乙　　200
4　4/1 　Ａ 　 丙　　300
5　4/1 　Ｃ　　甲　　300
・・・　とかします。
３、受信する方のパソコンにも同様のファイルを作成します（仮にメインデータ）
４、マクロを作成します。
　例えば、受信した日次データを開くと
　　　　　自動でマクロが実行される。
　　　　　日次データのデータ部分をコピィ
　　　　　メインデータを開いて、データの最終行以降に貼り付ける
　　　　　メインデータを上書き保存して終了する
５、メインデータのブックに集計のシートを作成しておきて、
　　日付ごとに　合計が集計されるようにしておく。

このようにしておけば、毎日、受信した添付ファイルを開くだけの作業ですみます。
データの量によっては、メインデータのファイルをアクセスに致します。