Reinstalando todo...
Private Sub GoToLastSavedPosition()
Dim strSQL As String
Dim rstFormPositions As DAO.Recordset
strSQL = " SELECT Last(tblFormPositions.LastRecordID) AS LastOfLastRecordID," & _
" Last(tblFormPositions.LastActiveControl) AS LastOfLastActiveControl," & _
" Max(tblFormPositions.LastTimeSaved) AS MaxOfLastTimeSaved" & _
" FROM tblFormPositions" & _
" GROUP BY tblFormPositions.FormName," & _
" tblFormPositions.LastUser" & _
" HAVING tblFormPositions.FormName = " & Chr$(34) & Me.Name & Chr$(34) & _
" AND tblFormPositions.LastUser = " & Chr$(34) & CurrentUser() & Chr$(34)
Set rstFormPositions = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
With rstFormPositions
If .RecordCount <> 0 Then
If !LastOfLastRecordID <> 0 And Not IsNull(!LastOfLastActiveControl) Then
Me.RecordsetClone.FindFirst "[ID] = " & !LastOfLastRecordID
Me.Bookmark = Me.RecordsetClone.Bookmark
Me(!LastOfLastActiveControl).SetFocus
End If
End If
.Close
End With
Set rstFormPositions = Nothing
End Sub
Private Sub Form_Timer()
Static blnFormOpen As Boolean
If Not blnFormOpen Then
blnFormOpen = True
Me.TimerInterval = 0
GoToLastSavedPosition
End If
End Sub

Function DamePC() As String
Set ObjetoRed = CreateObject("WScript.Network")
DamePC = ObjetoRed.ComputerName
Set ObjetoRed = Nothing
End Function
Public Enum eUtl_TildesRestriccion
Libre = 0
Restringido = 1
Estricto = 2
End Enum
Function SinTildesEvo(strText As String, Optional intSinEspeciales As eUtl_TildesRestriccion = 0, Optional strEspeciales As String = ".,:;()-&%!?¡¿ºª*çÇ@_·)$") As String
On Error GoTo ErrorHandler
Dim strConAcentos As String
Dim strSinAcentos As String
Dim c As Integer
Dim strChar As String
Dim intPos As Integer
Dim strLimpia1 As String
Dim strLimpia2 As String
strConAcentos = "áàäâéèëêíìïîóòöôúùüûÁÀÄÂÉÈËÊÍÌÏÎÓÒÖÔÚÙÜÛ"
strSinAcentos = "aaaaeeeeiiiioooouuuuAAAAEEEEIIIIOOOOUUUU"
' Recorremos el texto pasado como argumento
For c = 1 To Len(strText)
' Obtenemos el carácter a evaluar
strChar = Mid(strText, c, 1)
' Miramos si existe en la cadena de caracteres acentuados
intPos = InStr(1, strConAcentos, strChar, vbBinaryCompare)
If intPos > 0 Then
' Al existir sustituimos
strLimpia1 = strLimpia1 & Mid(strSinAcentos, intPos, 1)
Else
' Al no existir lo aceptamos
strLimpia1 = strLimpia1 & strChar
End If
Next
' Evaluamos si se quitan los especiales
Select Case intSinEspeciales
Case eUtl_TildesRestriccion.Libre ' Sin restricción: no se obvia ningún caracter especial
' Igualamos cadenas
strLimpia2 = strLimpia1
Case eUtl_TildesRestriccion.Restringido ' Restrictivo:solo los de la lista
' Recorremos la cadena
For c = 1 To Len(strLimpia1)
' Obtenemos el caracter a evaluar
strChar = Mid(strLimpia1, c, 1)
' Miramos si existe en la cadena de caracteres especiales
intPos = InStr(1, strEspeciales, strChar, vbBinaryCompare)
If intPos = 0 Then
' Al no existir podemos añadir el caracter
strLimpia2 = strLimpia2 & strChar
End If
Next
Case eUtl_TildesRestriccion.Estricto ' Ultrarestrictivo: ningun caractrer que no sea letra, numero o espacio
For c = 1 To Len(strLimpia1)
strChar = Mid(strLimpia1, c, 1)
Select Case Asc(strChar)
Case 48 To 57, 65 To 90, 97 To 122, 32
strLimpia2 = strLimpia2 & strChar
End Select
Next
End Select
SinTildesEvo = strLimpia2
ExitProcedure:
On Error GoTo 0
Exit Function
ErrorHandler:
Select Case Err.Number
Case 0
Case Else
MsgBox "Error " & Err.Number & " - " & Err.Description
Resume ExitProcedure
End Select
End Function
Public Function ExistsFolder(strFolder As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
If fso.FolderExists(strFolder) = False Then
ExistsFolder = False
Else
ExistsFolder = True
End If
If Err <> 0 Then
ExistsFolder = False
End If
Set fso = Nothing
End Function
Public Function ExistsFile(strFileName As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
If fso.FileExists(strFileName) = False Then
ExistsFile = False
Else
ExistsFile = True
End If
If Err <> 0 Then
ExistsFile = False
End If
Set fso = Nothing
End Function
Cita de: KALKALIN preguntó
Necesito poder revincular las tablas de una base de datos externa.
Option Compare Database
Option Explicit
Public Type udtLinkTable
RemoteDatabase As String
RemoteTableName As String
LocalTableName As String
End Type
Public uLinkTable As udtLinkTable
Public Sub CrearTablaVinculada()
Dim dbsActual As DAO.Database
Dim tdfTableLink As DAO.TableDef
Dim rstRemoto As DAO.Recordset ' para las pruebas (en producción borrar y eliminar las últimas líneas)
'Ubicacion de la base de datos remota se toma de uLinkTable.RemoteDatabase
'Ubicacion de la base de datos local se toma de CurrentProject.FullName
' Abre la base de datos a la que se le va a agregar la tabla vinculada.
Set dbsActual = OpenDatabase(CurrentProject.FullName)
' Crea una tabla vinculada que se conecta a una base de datos Access
' uLinkTable.LocalTableName será el nombre de la nueva tabla vinculada (en la base local)
Set tdfTableLink = dbsActual.CreateTableDef(uLinkTable.LocalTableName)
'creamos la conexion
tdfTableLink.Connect = ";DATABASE=" & uLinkTable.RemoteDatabase & ";"
'Aqui uLinkTable.LocalTableName es el nombre de la tabla de origen (si no existe da error)
tdfTableLink.SourceTableName = uLinkTable.RemoteTableName
dbsActual.TableDefs.Append tdfTableLink
Set rstRemoto = dbsActual.OpenRecordset(uLinkTable.LocalTableName)
'muestro la cantidad de registros de la tabla vinculada (Algo sencillo para ver si todo ha salido bien)
rstRemoto.MoveLast
MsgBox rstRemoto.RecordCount
rstRemoto.Close
End Sub
Me!UnControl.AfterUpdate = "=UnaFuncion()"Me!UnControl.AfterUpdate = ""