Terima kasih Pak Sam...
Kodenya belum saya coba, sepertinya lengkap dengan cmdbrowse dan cmdconnect ya... :)
Tapi telah berhasil dengan kode berikut :
CurrentProject.path _
& "\..\folder_BE\BE"
Nama filenya 'Path relink antar folder.rar' bisa dilihat di:
http://tech.groups.yahoo.com/group/belajar-access/files/Kreasi_Access/
Atau di :
http://tech.groups.yahoo.com/group/belajar-access/message/36237
Salam Access,
Josh
--- In belajar-access@yahoogroups.com, sam duhay <samduhay@...> wrote:
>
> 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@...> wrote:
>
> From: Sofyan Efendi <sofyanefendi@...>
> 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@...>
>
> 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
>
> >
>
> >
>
> >
>
Reply via web post | Reply to sender | Reply to group | Start a New Topic | Messages in this topic (7) |
No comments:
Post a Comment