MS ACCESS MAILING LIST: Re: [belajar-access] Path relink antar folder

mencoba menjawab,

kode ini juga dari milis ini (terima kasih tmn2 atas kodenya) dengan ada modifikasi

1 . buat modul :

Option Compare Database

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Function LaunchCD(strform As Form) As String
    Dim OpenFile As OPENFILENAME
    Dim lReturn As Long
    Dim sFilter As String
    OpenFile.lStructSize = Len(OpenFile)
    OpenFile.hwndOwner = strform.Hwnd
    sFilter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0) & _
      "JPEG Files (*.JPG)" & Chr(0) & "*.JPG" & Chr(0)
    OpenFile.lpstrFilter = sFilter
    OpenFile.nFilterIndex = 1
    OpenFile.lpstrFile = String(257, 0)
    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    OpenFile.lpstrInitialDir = "C:\"
    OpenFile.lpstrTitle = "Select a file using the Common Dialog DLL"
    OpenFile.flags = 0
    lReturn = GetOpenFileName(OpenFile)
        If lReturn = 0 Then
            MsgBox "A file was not selected!", vbInformation, _
"Select a file using the Common Dialog DLL"
         Else
            LaunchCD = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
         End If
End Function

2. buat tabel 1 field dengan nama TBLLink field NamaTBL

   isi tabel dengan object tabel yang akan di link kan

3. buat form berisi textbox100, cmdbrowse ,cmdconnect
    isi form dengan code
   Private Sub cmdbrowse_Click()
Me!Text100 = LaunchCD(Me)
End Sub

Private Sub cmdConnect_Click()
Dim rs As dao.Recordset
Dim rq As dao.Recordset
Dim strType, strODBC As String
If IsNull(Me.Text100.Value) Then
MsgBox " path kosong , klik browse", vbCritical, "Samduhay"
GoTo b:
End If
On Error GoTo errHandler:

    strType = "Microsoft Access"
    strODBC = Text100
     Set rs = CurrentDb.OpenRecordset("Select NamaTBL from TBLLink")
   Set rq = CurrentDb.OpenRecordset("SELECT MSysObjects.Name AS table_name, Left([Name],1), Left([Name],4), MSysObjects.Type FROM MSysObjects WHERE (((Left([Name],1))) AND ((Left([Name],4))<>'MSys' And (Left([Name],4)) Not Like 'f_*') AND ((MSysObjects.Type)=6)) ORDER BY MSysObjects.Name")

     rs.MoveFirst
errHandler:
     If ERR.Number = 3021 Then GoTo a:
     rq.MoveFirst

      Do Until rq.EOF
       If ERR.Number = 2498 Then GoTo a:
       DoCmd.DeleteObject acTable, rq!table_name
     rq.MoveNext
     Loop
     MsgBox "hapus Koneksi Data Selesai", vbInformation, "samduhay"

a:
    Do Until rs.EOF
        DoCmd.Echo -1, "Refreshing untuk tabel : " & rs!NamaTBL


         DoCmd.TransferDatabase acLink, strType, _
        strODBC, acTable, rs!NamaTBL, rs!NamaTBL, , 0
        rs.MoveNext

    Loop
    MsgBox "Koneksi Data Selesai", vbInformation, "FINISH"
b:
End Sub

smg membantu

--- On Tue, 1/1/13, Sofyan Efendi <sofyanefendi@gmail.com> wrote:

From: Sofyan Efendi <sofyanefendi@gmail.com>
Subject: Re: [belajar-access] Path relink antar folder
To: belajar-access@yahoogroups.com
Date: Tuesday, January 1, 2013, 11:02 PM

Dear Mas Josh, saya belum mencobanya, tapi seingat saya di HTML menggunakan
kode titik sebanyak dua kali. Misal:

CurrentProject.path & "..\folder_BE\BE"

Wassalaamu'alaikum Warahmatullahi Wabarakatuh,
Sofyan Efendi
----- Original Message -----
From: "Josh" <joshacmail@yahoo.com>
To: <belajar-access@yahoogroups.com>
Sent: Wednesday, January 02, 2013 11:47 AM
Subject: [belajar-access] Path relink antar folder

> Dear Pak Sofyan dan rekan Access sekalian...
>
> Bila dalam satu folder_Aplikasi terdapat FE dan folder_BE, kemudian di
> folder_BE terdapat BE
>
> Maka path_relink FE ke BE dapat seperti ini :
>
> CurrentProject.path _
> & "\folder_BE\BE"
>
>
> Sehingga relink tetap sukses kemanapun folder_Aplikasi di pindah,asalkan
> dalam folder_Aplikasi tersebut terdapat FE dan folder_BE yang berisi BE.
>
>
> Namun bila dalam satu folder_Aplikasi terdapat folder_FE dan folder_BE,
> kemudian di folder_FE terdapat FE, sedangkan di folder_BE terdapat BE
>
> Bagaimanakah path_relink FE ke BE nya (namun bukan dengan kode 'cari
> file')...?
>
> Sehingga relink tetap sukses kemanapun folder_Aplikasi di pindah,asalkan
> dalam folder_Aplikasi tersebut terdapat folder_FE yang berisi FE dan
> folder_BE yang berisi BE.
>
> Jadi intinya bagaimanakah penulisan path untuk relink antar folder, yaitu
> BE dalam folder di luar folder FE tersebut...?
>
> Saya sudah coba cari di arsip millis tidak ada, begitu juga dengan search
> google...
>
> Banyak terima kasih sebelum dan sesudahnya...
>
> Salam Access,
> Josh
>
>
>
>
> ------------------------------------
>
> SPAM IS PROHIBITEDYahoo! Groups Links
>
>
>