[Resolvido]Inserindo Valores em tabela no Back End através do Insert Into

Amigos como fazer corretamente isto?

INSERT INTO PDF_Final ( id, idPDF, selecionado, DataCriacao ) SELECT PDF.id , PDF.idPDF, PDF.selecionado, " _
& "PDF.DataCriacao FROM PDF IN '" & strPathLocal & "'"


Grato pela ajuda...

Estou tentando algo assim mas não esta dando certo

Sub InserirTabela()
Dim NomeBD_Local As String
Dim strPathLocal As String
Dim dbBancoLocal As Database
Dim db As DAO.Database

NomeBD_Local = "SYSPEN_be_Local.accdb"

'String com path para conexão com a base de dados.
strPathLocal = DirBancoDadosLocal & NomeBD_Local ' Conecta ao banco de dados local
Set dbBancoLocal = OpenDatabase(strPathLocal)
Set db = OpenDatabase(strPathLocal)

DoCmd.SetWarnings False
dbExecute ("INSERT INTO PDF_Final id, idPDF, selecionado, DataCriacao) SELECT PDF.id , PDF.idPDF, PDF.selecionado, " _
& "PDF.DataCriacao FROM PDF IN '" & strPathLocal & "'")
DoCmd.SetWarnings True

End Sub

Tentei assim tabem

DoCmd.RunSQL ("INSERT INTO PDF_Final id, idPDF, selecionado, DataCriacao) SELECT PDF.id , PDF.idPDF, PDF.selecionado, " _
& "PDF.DataCriacao FROM PDF IN '" & strPathLocal & "'")

Nào da certo

Amigão só uma dica

O Insert é uma instrução de execução

Declare o Sql em uma string e

use DoCmd.Execute

Eu to sem exemplos aqui no novo trabalho mas é mais ou menos como abaixo:

Dim Strsql as String

Strsql = "INSERT INTO PDF_Final id, idPDF, selecionado, DataCriacao "
Strsql = Strsql & "VALUES PDF.id , PDF.idPDF, PDF.selecionado, "
Strsql = Strsql & "PDF.DataCriacao FROM PDF IN '" & strPathLocal & "'""

DoCmd.Execute Strsql

Sds,

Bom dia Charles... entendi...

Encontrei uma função que me serviu perfeitamente... so preciso de adapta-la para que ao inves de usar
o CurrentDB, me permita inserir o caminho do BackEnd


se puder me ajudar com isso



Option Compare Database
Option Explicit


Function AppendTable(toTableName As String, frmTableName As String, _
Campo As String, Campo2, Campo3, Campo4 As String) As Boolean

'Acrescentar a uma tabela valores de outra tabela.
'ToTableName: Nome da tabela para inserção
'FrmTableName: Nome da tabela dos dados de origem
'Campo: Nome do campo que receberá os valores
'Campo1: Nome do campo que receberá os valores
'Campo2: Nome do campo que receberá os valores
'Campo2: Nome do campo que receberá os valores

'Retorna True se tiver sucesso, false caso contrário
'USO no Módulo do Form: AppendTable "toTableName", "frmTableName", "Campo", "Campo1, Campo2, Campo3"
On Error GoTo errhandler
Dim strSql As String, Db As DAO.Database



'Cria Append Into Select SQL da nossa sequencia dos valores dos campos
strSql = "INSERT INTO " & toTableName & "(" & Campo & ", " & Campo2 & ", " & Campo3 & "," & Campo4 & ")" & _
" SELECT " & "[" & frmTableName & "]." & Campo & ",[" & frmTableName & "]." & Campo2 & ", " & Campo3 & ", " & Campo4 & _
" FROM " & frmTableName & ";"


'Imprimir o SQL para que possamos colar na consulta construída se houver erros
Debug.Print strSql
'Usa o BD no diretório do mesmo
Set Db = CurrentDb()


'Executa a consulta SQL Query
Db.Execute strSql

'Se nao há erros retorna true
AppendTable = True
ExitHere:

Set Db = Nothing

'Notifica ao usuário que o preocesso está completo.
MsgBox "Operação realizada com sucesso!"
Exit Function
errhandler:
'Quando há um erro retorna false
AppendTable = False
With err
MsgBox "Error " & .Number & vbCrLf & .Description, _
vbOKOnly Or vbCritical, "AppendTable"
End With
Resume ExitHere
End Function




Function CreateField( _
ByVal strTableName As String, _
ByVal strCampo As String) _
As Boolean

'Cria um campo de texto com o nome = strCampo Na tabela strTableName
'Aceita
'StrTableName: Nome da tabela irá criar o campo
'StrCampo: Nome do novo campo
'Retorna True se tiver sucesso, false caso contrário


On Error GoTo errhandler
Dim Db As DAO.Database
Dim fld As DAO.Field
Dim tdf As DAO.TableDef

Set Db = Application.CurrentDb
Set tdf = Db.TableDefs(strTableName)
' Primeiro, crie um campo com datatype = Text
Set fld = tdf.CreateField(strCampo, dbText)

With tdf.Fields
.Append fld
.Refresh
End With

CreateField = True

ExitHere:
Set fld = Nothing
Set tdf = Nothing
Set Db = Nothing
Exit Function
errhandler:
CreateField = False
With err
MsgBox "Error " & .Number & vbCrLf & .Description, _
vbOKOnly Or vbCritical, "CreateAdditionalField"
End With
Resume ExitHere
End Function


Function RenameField(strTableName As String, OldstrCampo As String, strCampo As String)
' Esta rotina muda os campos na tabela strTableName.
'Aceita
'StrTableName: Nome da tabela em que vai alterar o campo
'OldstrCampo: Nome do campo Antigo
'StrCampo: Nome do novo campo
'Retorna True se tiver sucesso, false caso contrário

Dim Db As Database
Dim td As TableDef
Dim fld As Field

On Error GoTo errhandler

Set Db = CurrentDb()
Set td = Db.TableDefs(strTableName)

' Renomeia o campo
td.Fields(OldstrCampo).Name = strCampo



ExitHere:
Set fld = Nothing
Set td = Nothing
Set Db = Nothing
Exit Function
errhandler:

With err
MsgBox "Error " & .Number & vbCrLf & .Description, _
vbOKOnly Or vbCritical, "ChangeField Reference: " & OldstrCampo
End With
Resume ExitHere

End Function

Public Function ifFieldExists(fldName As String, TableName As String) As Boolean
Dim rs As Recordset, Db As Database 'Sub DAO Vars
On Error GoTo fs

'verifica se uma tabela está lá e relatórios Verdadeiro ou Falso.

Set Db = CurrentDb()

'Se há tabela, abre-a
Set rs = Db.OpenRecordset("Select " & fldName & " from " & TableName & ";")

ifFieldExists = True
rs.Close
Db.Close

Exit Function

fs:
'Se a tabela nao é encontrada, fecha e seta a função para False
Set rs = Nothing
Db.Close
Set Db = Nothing

ifFieldExists = False
Exit Function
End Function

Bem amigo.. com um pouco de fumaça saindo pelas orelhas!!!


Eis o Baita!


Perfect!


Option Compare Database
Option Explicit


Function AppendTable(toTableName As String, frmTableName As String, _
Campo As String, Campo2, Campo3, Campo4 As String) As Boolean

Parametros_de_Inicializacao "SysPen.par"
Dim db As DAO.Database
Dim ws As DAO.Workspace

Set ws = DBEngine.Workspaces(0)
'Set db = ws.OpenDatabase(DirBancoDados & "\Syspen_Be_Local.accdb", False, False, "MS Access;PWD=senha")

'Acrescentar a uma tabela valores de outra tabela.
'ToTableName: Nome da tabela para inserção
'FrmTableName: Nome da tabela dos dados de origem
'Campo: Nome do campo que receberá os valores
'Campo1: Nome do campo que receberá os valores
'Campo2: Nome do campo que receberá os valores
'Campo2: Nome do campo que receberá os valores

'Retorna True se tiver sucesso, false caso contrário
'USO no Módulo do Form: AppendTable "toTableName", "frmTableName", "Campo", "Campo1, Campo2, Campo3"
On Error GoTo errhandler
Dim strSql As String



'Cria Append Into Select SQL da nossa sequencia dos valores dos campos
strSql = "INSERT INTO " & toTableName & "(" & Campo & ", " & Campo2 & ", " & Campo3 & "," & Campo4 & ")" & _
" SELECT " & "[" & frmTableName & "]." & Campo & ",[" & frmTableName & "]." & Campo2 & ", " & Campo3 & ", " & Campo4 & _
" FROM " & frmTableName & ";"


'Imprimir o SQL para que possamos colar na consulta construída se houver erros
Debug.Print strSql
'Usa o BD no diretório do mesmo
'Set Db = CurrentDb()
Set db = ws.OpenDatabase(DirBancoDados & "\Syspen_Be_Local.accdb", False, False, "MS Access;PWD=senha")

'Executa a consulta SQL Query
db.Execute strSql

'Se nao há erros retorna true
AppendTable = True
ExitHere:

Set db = Nothing

'Notifica ao usuário que o preocesso está completo.
MsgBox "Operação realizada com sucesso!"
Exit Function
errhandler:
'Quando há um erro retorna false
AppendTable = False
With err
MsgBox "Error " & .Number & vbCrLf & .Description, _
vbOKOnly Or vbCritical, "AppendTable"
End With
Resume ExitHere
End Function




Function CreateField( _
ByVal strTableName As String, _
ByVal strCampo As String) _
As Boolean

'Cria um campo de texto com o nome = strCampo Na tabela strTableName
'Aceita
'StrTableName: Nome da tabela irá criar o campo
'StrCampo: Nome do novo campo
'Retorna True se tiver sucesso, false caso contrário


On Error GoTo errhandler
Dim db As DAO.Database
Dim ws As DAO.Workspace
Dim fld As DAO.Field
Dim tdf As DAO.TableDef
Parametros_de_Inicializacao "SysPen.par"


Set ws = DBEngine.Workspaces(0)

'Set db = Application.CurrentDb
Set db = ws.Application(DirBancoDados & "\Syspen_Be_Local.accdb", False, False, "MS Access;PWD=senha")

Set tdf = db.TableDefs(strTableName)
' Primeiro, crie um campo com datatype = Text
Set fld = tdf.CreateField(strCampo, dbText)

With tdf.Fields
.Append fld
.Refresh
End With

CreateField = True

ExitHere:
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
Exit Function
errhandler:
CreateField = False
With err
MsgBox "Error " & .Number & vbCrLf & .Description, _
vbOKOnly Or vbCritical, "CreateAdditionalField"
End With
Resume ExitHere
End Function


Function RenameField(strTableName As String, OldstrCampo As String, strCampo As String)
' Esta rotina muda os campos na tabela strTableName.
'Aceita
'StrTableName: Nome da tabela em que vai alterar o campo
'OldstrCampo: Nome do campo Antigo
'StrCampo: Nome do novo campo
'Retorna True se tiver sucesso, false caso contrário

Dim db As Database
Dim td As TableDef
Dim fld As Field
Dim ws As DAO.Workspace
Parametros_de_Inicializacao "SysPen.par"


Set ws = DBEngine.Workspaces(0)

On Error GoTo errhandler

'Set db = CurrentDb()
Set db = ws.OpenDatabase(DirBancoDados & "\Syspen_Be_Local.accdb", False, False, "MS Access;PWD=senha")

Set td = db.TableDefs(strTableName)

' Renomeia o campo
td.Fields(OldstrCampo).Name = strCampo



ExitHere:
Set fld = Nothing
Set td = Nothing
Set db = Nothing
Exit Function
errhandler:

With err
MsgBox "Error " & .Number & vbCrLf & .Description, _
vbOKOnly Or vbCritical, "ChangeField Reference: " & OldstrCampo
End With
Resume ExitHere

End Function

Public Function ifFieldExists(fldName As String, TableName As String) As Boolean
Parametros_de_Inicializacao "SysPen.par"
Dim rs As Recordset 'Sub DAO Vars
Dim db As DAO.Database
Dim ws As DAO.Workspace

On Error GoTo fs
Set ws = DBEngine.Workspaces(0)
'verifica se uma tabela está lá e relatórios Verdadeiro ou Falso.

'Set db = CurrentDb()
Set db = ws.OpenDatabase(DirBancoDados & "\Syspen_Be_Local.accdb", False, False, "MS Access;PWD=senha")


'Se há tabela, abre-a
Set rs = db.OpenRecordset("Select " & fldName & " from " & TableName & ";")

ifFieldExists = True
rs.Close
db.Close

Exit Function

fs:
'Se a tabela nao é encontrada, fecha e seta a função para False
Set rs = Nothing
db.Close
Set db = Nothing

ifFieldExists = False
Exit Function
End Function

É isso ai amigo,

Outra coisa, quando fazer

qualquer Update ou Insert em banco Externo

Basta Declarar a String de Conexão usando o Metodo Open

e depois é só executar o SQL

Fica muito mais simples prático e elimina muito código

Valeu

PS - Tava Falando de ADO ok!

Grato Amigão...
Eu sei que tem jeito de fazer isso de maneira mais simples...

Mas eu gostei desta função... porque voce pode usar para varias tabelas, para isso utilizando no form uma instrução simples que é:


'Verifica se o campo para inserção está presente
If ifFieldExists("IDPDF", "PDF") Then
'Se o campo exite chama a função para a inserção
AppendTable "PDF_Final", "PDF", "ID", "idPDF", "selecionado", "DataCriacao"


para isso pode se usar diversas vezes a mesma função no form, para isso alterando apenas o nome das tabelas e dos campos..

Neste caso a minha funcão esta alterando apenas 4 campos..


Obrigado pela dica... Postei um exemplo na sala de repositórios..
1 - um para tabelas locais..
2 - outro para tabelas em bd externo e usando um arquivo de parametrização externo


Saudações