Solved

Transfering Text From Excel to Access

Posted on 2006-07-24
2
361 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
2 Comments
 
LVL 6

Accepted Solution

by:
mwharff earned 500 total points
Comment Utility
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
Comment Utility
Thank you!
0

Featured Post

6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

Join & Write a Comment

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

743 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

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now