Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

30 Mayıs 2003 Cuma

Data transfer in to the Excel from Word

Option Explicit
Dim wdApp As Object
Dim wdDoc As Object
Dim wdPth As String
Dim wdNam As String
Dim wdNo As Long
'No: Kullanımda olan dosyalar için "Read Only" seçeneği işaretlenmelidir.
Sub WordData_To_Excel()
On Error Resume Next
Application.ScreenUpdating = False
Range("A:B").ClearContents
Set wdApp = CreateObject("Word.Application")
wdPth = "d:\" 'Word dosyalarınızın bulunduğu klasördür...
If VBA.Right(wdPth, 1) <> "\" Then wdPth = wdPth & "\"
wdNam = VBA.Dir(wdPth & "*.doc*")
wdNo = 0
Do While VBA.Len(wdNam) > 0
wdNo = wdNo + 1
Set wdDoc = wdApp.Documents.Open(wdPth & wdNam)
Cells(wdNo, 1).Value = wdDoc.Range.Text
Cells(wdNo, 2).Value = wdNam
wdDoc.Close savechanges:=False
wdNam = VBA.Dir
Loop
wdApp.Quit
Application.ScreenUpdating = True
If wdNo = 0 Then MsgBox "Seçmiş olduğunuz klasörde herhangibir word dosyaya rastlanmamıştır...", vbExclamation
End Sub

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul