MyDesign | Kod Arşivi - Anasayfaya Dön   No banner in farm
Anasayfa Araştır Forum Gelişmiş Arama Siteniz İçin En Hit İçerikler RSS İçerik Ekle Scriptler Destekleyenler Kadromuz Reklam İletişim Giriş Sayfası Yap  Sık Kullanılanlara Ekle
Bu Kategorinin En Yeni Kodları:


Bu Kategorinin En Çok Görüntülenen Kodları:






Arama:
Gelişmiş Arama


No banner in farm



En Çok Görüntülenen Kodlar:


Üye Girişi:
 Üye Ol



Anasayfa > VisualBasic > Kodlar

Access'ten Excel'e Veri Aktarımı

Accessveritabanı tablosundaki verileri Excel'e aktaran program

Kategori : VisualBasic
Gönderen : LonG
Telif :
Tarih : 19 Temmuz 2005
Örnek Dosya : İndir
Okunma Sayısı : 26915
Puan
: 8,5 / 10 (14 Oy)
Puan Verin :
Google Bookmarks  del.icio.us  Digg  Yahoo! MyWeb  Windows Live  Furl
 
 
Option Explicit
Private strExcelFile As String
Private strWorksheet As String
Private strDB As String
Private strTable As String
Private objDB As Database
Private strField As String
Private strSearch As String
Private DB As Database
Private WildCard As String
Private textString As String
Private UsedBrowse As Boolean
Private Sub ExportOneTable()

'EXPORTS TABLE IN ACCESS DATABASE TO EXCEL
'REFERENCE TO DAO IS REQUIRED


Set objDB = OpenDatabase(strDB)

 'If excel file already exists, you can delete it here
' If Dir(strExcelFile) <> "" Then Kill strExcelFile

objDB.Execute _
  "SELECT * INTO [Excel 8.0;DATABASE=" & strExcelFile & _
   "].[" & strWorksheet & "] FROM " & "[" & strTable & "]" & _
   "WHERE [" & strTable & "." & strField & "]like '" & WildCard & strSearch & WildCard & "';"
objDB.Close
Set objDB = Nothing

End Sub
Function FieldType(intType As Integer) As String

    Select Case intType
        Case dbBoolean
            FieldType = "Boolean"
        Case dbByte
            FieldType = "Byte"
        Case dbInteger
            FieldType = "Integer"
        Case dbLong
            FieldType = "Long"
        Case dbCurrency
            FieldType = "Currency"
        Case dbSingle
            FieldType = "Single"
        Case dbDouble
            FieldType = "Double"
        Case dbDate
            FieldType = "Date"
        Case dbText
            FieldType = "Text"
        Case dbLongBinary
            FieldType = "LongBinary"
        Case dbMemo
            FieldType = "Memo"
        Case dbGUID
            FieldType = "GUID"
    End Select

End Function
Private Sub GetDB()
  CommonDialog1.DialogTitle = "Browse for Database File"
  CommonDialog1.Filter = "Database File (*.mdb)|*.mdb"
  CommonDialog1.DefaultExt = ".mdb"
  CommonDialog1.DialogTitle = "Browse for Database File"
  CommonDialog1.ShowOpen
  Text1.Text = CommonDialog1.FileName
  UsedBrowse = True
End Sub
Private Sub FillList1()
Dim DBName As String
Dim X As Integer
  On Error GoTo ExitSub
  
  If Right(Text1.Text & textString, 4) = ".mdb" Then
    Set DB = OpenDatabase(Text1.Text & textString)
     'Extract tables from DataBase and add to combobox...
    Screen.MousePointer = 11
    List1.Clear
    For X = 0 To DB.TableDefs.Count - 1
      'Ignore system tables...
      If InStr(UCase(DB.TableDefs(X).Name), "MSYS") = 0 Then
        List1.AddItem DB.TableDefs(X).Name
      End If
    Next X
    If List1.ListCount > 0 Then List1.ListIndex = 0
    Screen.MousePointer = 0
  End If
ExitSub:
End Sub

Private Sub cmdBrowse_Click()
  GetDB
  FillList1
  
End Sub

Private Sub cmdCancel_Click()
  End
End Sub

Private Sub cmdClear_Click()
 Text1.Text = ""
 List1.Clear
 List2.Clear
 lblFieldType = ""
 txtSearch = ""
 txtWorkSheetName = ""
End Sub

Private Sub cmdOK_Click()
  If Text1.Text <> "" Then
    CommonDialog1.DialogTitle = "Save to Excel File"
    CommonDialog1.FileName = ""
    CommonDialog1.DefaultExt = ".xls"
    CommonDialog1.Filter = "Excel File (*.xls)|*.xls"
    CommonDialog1.ShowSave
    strExcelFile = CommonDialog1.FileName
    strWorksheet = txtWorkSheetName
    If strWorksheet = "" Then
      strWorksheet = "WorkSheet1"
    End If
    strDB = Text1.Text
    strTable = List1.Text
    strField = List2.Text
    strSearch = txtSearch
    If chkExact = 1 Then
      WildCard = ""
    Else
      WildCard = "*"
    End If
   ExportOneTable
  End If
CommonDialog1.Filter = "Database File(*.mdb)|*.mdb"
CommonDialog1.DefaultExt = ".mdb"
CommonDialog1.DialogTitle = "Browse for Database File"
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
DB.Close
Set DB = Nothing
End Sub

Private Sub List1_Click()
List1.SetFocus
UpdateFields
End Sub

Private Sub List1_KeyDown(KeyCode As Integer, Shift As Integer)
UpdateFields
End Sub

Private Sub UpdateFields()
  Dim X As Integer
  Dim RstTemp
  Screen.MousePointer = 11
  List2.Clear
  Set RstTemp = DB.OpenRecordset(List1.Text)
  For X = 0 To RstTemp.Fields.Count - 1
    List2.AddItem RstTemp.Fields(X).Name
  Next X
  If List2.ListCount > 0 Then List2.ListIndex = 0
  Screen.MousePointer = 0
  RstTemp.Close
  Set RstTemp = Nothing
End Sub

Private Sub List2_Click()
Dim RstTemp As Recordset
  Set RstTemp = DB.OpenRecordset(List1.Text)
  lblFieldType = FieldType(RstTemp.Fields(List2.ListIndex).Type)
  RstTemp.Close
  Set RstTemp = Nothing
  
End Sub


Private Sub Text1_DblClick()
 Text1.SelLength = Len(Text1.Text)
End Sub


Private Sub Text1_KeyPress(KeyAscii As Integer)
List1.Clear
List2.Clear
lblFieldType = ""
textString = Chr(KeyAscii)
FillList1
textString = ""
End Sub

Private Sub Text1_LostFocus()
  FillList1
End Sub
 
 

Access'ten Excel'e Veri Aktarımı için yazılan yorumlar

osman yıldırım   { 08 Ocak 2010 }
slm arkadaslar bana acces de nasıl hesap makınesi yapılır solermısınız yıllık odevim ole verildi bn o kadar aradım ama pek işe yarar bişe bulamadım simdiden tesekkurler..

geniu125   { 11 Mart 2007 }
Bence çok yararlı bir çalışma - arkadaşa teşekkür ediyorum!

Yorum ekleyin

Anasayfa > VisualBasic > Kodlar > Access'ten Excel'e Veri Aktarımı
Kategoriler:


Forum:



Bağlantılar:


En Son Yorumlanan İçerikler:


Murat Yavuz | Site Haritası | Gizlilik Bildirimi | 54.162.165.158 | 0,12 Saniye
© Copyright 2004-2018 MyDesign | Kod Arşivi. Tüm Hakları Saklıdır.
MyDesign | Kod Arşivi, en iyi görünüm için, 1024x768 ve üzeri çözünürlük tavsiye eder.