Loesung.
02.03.2004 15:33:13
Alexej
Sodele, habs doch noch ohne jegliche VBA Kentnisse geschafft, es zum laufen zu kriegen :))
'written by Alexej Ratner
'çàìåíèòü ïóòü ê ôàéëó è íàçâàíèå ôàéëà, ÷òî áû ðàáîòàëî íà âàøåì êîìïüþòåðå.
Sub GetInfo()
Dim App As Application
Dim Sel As Outlook.Selection
Dim Itm As Object
Dim Xls As Object
Dim i As Integer
Dim anhang As String
Set App = CreateObject("Outlook.Application")
Select Case App.ActiveWindow.Class
Case olExplorer
Set Sel = App.ActiveExplorer.Selection
If Sel.Count > 0 Then
Set Itm = Sel.Item(1)
End If
Case olInspector
Set Itm = App.ActiveInspector.CurrentItem
Case Else
End Select
If Itm.Attachments.Count <> 0 Then
anhang = "Åñòü"
Else: anhang = "Íåò"
End If
Set Xls = GetObject("c:\test\test2.xls") 'èçìåíèòü ïóòü ê ôàéëó
Xls.Application.Visible = True
Xls.Parent.windows("test2.xls").Visible = True 'èçìåíèòü íàçâàíèå ôàéëà
Xls.Application.activeworkbook.sheets(1).Activate
i = 1
Do While Xls.Application.cells(i, 1) <> ""
If Xls.Application.cells(i, 1) <> "" Then
i = i + 1
End If
Loop
Xls.Application.cells(i, 1).Font.Bold = True
Xls.Application.cells(i, 1).Value = "Íîìåð:"
Xls.Application.cells(i, 2).Value = i
Xls.Application.cells(i, 3).Font.Bold = True
Xls.Application.cells(i, 3).Value = "Êîìó:"
Xls.Application.cells(i, 4).Value = Itm.ReceivedByName
Xls.Application.cells(i, 5).Font.Bold = True
Xls.Application.cells(i, 5).Value = "CC:"
Xls.Application.cells(i, 6).Value = Itm.CC
Xls.Application.cells(i, 7).Font.Bold = True
Xls.Application.cells(i, 7).Value = "Îò êîãî:"
Xls.Application.cells(i, 8).Value = Itm.SenderName
Xls.Application.cells(i, 9).Font.Bold = True
Xls.Application.cells(i, 9).Value = "Òåìà:"
Xls.Application.cells(i, 10).Value = Itm.Subject
Xls.Application.cells(i, 11).Font.Bold = True
Xls.Application.cells(i, 11).Value = "Âðåìÿ:"
Xls.Application.cells(i, 12).Value = Itm.ReceivedTime
Xls.Application.cells(i, 13).Font.Bold = True
Xls.Application.cells(i, 13).Value = "Âëîæåíèå:"
Xls.Application.cells(i, 14).Value = anhang
Xls.Application.activeworkbook.sheets(1).Range("a" + "1").entirecolumn.autofit
Xls.Application.activeworkbook.sheets(1).Range("b" + "1").entirecolumn.autofit
Xls.Application.activeworkbook.sheets(1).Range("c" + "1").entirecolumn.autofit
Xls.Application.activeworkbook.sheets(1).Range("d" + "1").entirecolumn.autofit
Xls.Application.activeworkbook.sheets(1).Range("e" + "1").entirecolumn.autofit
Xls.Application.activeworkbook.sheets(1).Range("f" + "1").entirecolumn.autofit
Xls.Application.activeworkbook.sheets(1).Range("g" + "1").entirecolumn.autofit
Xls.Application.activeworkbook.sheets(1).Range("h" + "1").entirecolumn.autofit
Xls.Application.activeworkbook.sheets(1).Range("i" + "1").entirecolumn.autofit
Xls.Application.activeworkbook.sheets(1).Range("j" + "1").entirecolumn.autofit
Xls.Application.activeworkbook.sheets(1).Range("k" + "1").entirecolumn.autofit
Xls.Application.activeworkbook.sheets(1).Range("l" + "1").entirecolumn.autofit
Xls.Application.activeworkbook.sheets(1).Range("m" + "1").entirecolumn.autofit
Xls.Application.activeworkbook.sheets(1).Range("n" + "1").entirecolumn.autofit
Xls.Application.activeworkbook.Save
If Xls.Application.workbooks.Count > 1 Then
Xls.Parent.windows("test2.xls").Close 'èçìåíèòü íàçâàíèå ôàéëà
Else
Xls.Application.Quit
End If
Set Itm = Nothing
Set Sel = Nothing
Set App = Nothing
Set Xls = Nothing
End Sub