Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Transfering Text From Excel to Access

Posted on 2006-07-24
2
Medium Priority
?
388 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 2000 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

Independent Software Vendors: 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

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

721 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