Solved

Transfering Text From Excel to Access

Posted on 2006-07-24
2
373 Views
Last Modified: 2008-02-01
Excel VBA

I have this piece of code and it works great, now I need to take and add a field to the txt file before transfering to Access.  

I need to copy C2 and put it into A1 of the Text file and then add the rest starting in B2 of the Text file.  Is this possible?  

Any help would greatly be appreciated!  

/////////////////////////////////////////////////////////
Private Sub cmdTransferToSRP_Click()
'Copy Data and transfer to New Workbook
Dim rngToCopy As Range
Dim rngToPaste As Range

Dim r
  r = Range("E65536").End(xlUp).Row
  Range("D25:D" & r).FillDown

‘Add to A1???????
‘C2 to A1

‘Paste this starting in B2
Set rngToCopy = Range("D25:J" & Cells(Rows.Count, "D").End(xlUp).Row)
   
'Open new workbook to create text file
Workbooks.Add
rngToCopy.Copy
ActiveSheet.Paste

    Application.CutCopyMode = False
   
    Sheets("Sheet3").Select
    ActiveWindow.SelectedSheets.Delete
   
    Sheets("Sheet2").Select
    ActiveWindow.SelectedSheets.Delete
   
 Application.CutCopyMode = False
   
   
    'Export Text File
    ADOFromExcelToAccess
     
  ' Turns off "Do you want to replace this file?"
    Application.DisplayAlerts = False
   
    'Saves as a text file
    ActiveWorkbook.SaveAs Filename:="\\Dtcnas-ilsp002\mandatory\Analysts - Working Files\Carol\SRP\SRPTansferFile.txt" _
        , FileFormat:=xlText, CreateBackup:=False
     
    ActiveWorkbook.Close
   
 'opens access
   
   OpenAccess
End Sub
'////////////////////////////////////////////////
Sub OpenAccess()
Const cDatabaseToOpen = "\\Dtcnas-ilsp002\mandatory\Analysts - Working Files\Carol\SRP\SRPtwo.mdb"
    Dim oApp As Object
    Dim LPath As String
    Dim LCategoryID As Long
       
   
    'Path to Access database
    LPath = "\\Dtcnas-ilsp002\mandatory\Analysts - Working Files\Carol\SRP\SRPtwo.mdb"

    'Open Access and make visible
    Set oApp = CreateObject("Access.Application")
    oApp.Visible = True

    'Open Access database as defined by LPath variable and , false, dbpwd for password
    oApp.OpenCurrentDatabase LPath, False, False
   
    If oApp.CurrentProject.FullName <> "" Then
     oApp.UserControl = True
Else
     oApp.Quit
    MsgBox "Failed to open '" & cDatabaseToOpen & "'."
End If
 
 
End Sub
'////////////////////////////////////////////////////////////////////////////
Sub ADOFromExcelToAccess()
'Transfer data to the TransferFile
'//////////////////////////////
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
   
   
    ' connect to the Access database
    Set cn = New ADODB.Connection
   
 
  ''''''''''''''''''''''''''''''''''''''''
  'Workgroup Security
cn.Provider = "Microsoft Jet 4.0 OLE DB Provider"
cn.ConnectionString = "\\Dtcnas-ilsp002\mandatory\Analysts - Working Files\Carol\SRP\SRPtwo.mdb"
cn.Properties("Jet OLEDB:System database") = "C:\Program Files\Microsoft Office\system.mdw"
cn.Open


'''''''''''''''''''''''''
     
    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "DATA", cn, adOpenKeyset, adLockOptimistic, adCmdTable
      cn.Execute "delete * from DATA"
   
    ' all records in a table
    r = 25 ' the start row in the worksheet
    Do While Len(Range("D" & r).Formula) > 0
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("CompanyID") = Range("D" & r).Value
            .Fields("LoanID") = Range("E" & r).Value
            .Fields("ProrptyState") = Range("F" & r).Value
            .Fields("LoanAmt") = Range("G" & r).Value
            .Fields("NoteDate") = Range("H" & r).Value
            .Fields("NoteRate") = Range("I" & r).Value
            .Fields("LoanTerm") = Range("J" & r).Value
           
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop  
   
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing      
   
End Sub



0
Comment
Question by:ca1358
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
2 Comments
 
LVL 6

Accepted Solution

by:
mwharff earned 500 total points
ID: 17171337
Try replacing the code below

Dim r
Dim C2 as variant
  r = Range("E65536").End(xlUp).Row
  Range("D25:D" & r).FillDown

‘Add to A1???????
‘C2 to A1
C2 = Range("A1") 'Stores the value in C2
‘Paste this starting in B2
Set rngToCopy = Range("D25:J" & Cells(Rows.Count, "D").End(xlUp).Row)
   
'Open new workbook to create text file
Workbooks.Add
rngToCopy.Copy
ActiveSheet.Range("B2").Paste
ActiveSheet.Range("A1").value = c2 'Puts the value from C2 into A1

Hope this helps

0
 

Author Comment

by:ca1358
ID: 17171714
Thank you!
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…

726 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question