Import / Export from excel worksheets to text file

[Gunslinger]

HI GUys,

need a little help with this, I need to transfer multiple cell contents from multiple sheets within a workbbook to a text file, and then be able to import the data back to the relevant cells at a later date.

The cells in question will always be the same ones, but sometimes will be blank, so need to transfer blanks as well.

I intend to run this from a command button (already created) and want it to save to either a text file or '.nfo' file i want the code to choose a default name and destination, but would like the user to have the option to change this when saving,
Also when importing i need my workbook to check that the text file it is importing is for my workbook, i assume this can be done with a simple check to see if the first line has certain text in it (which can be inserted on saving the data in the first place)

Thanks

[biswajitdas]

hi Gunslinger


the problem you have is a combination of Fso object and ecel file

you can read and write a excel work book through excel object by
getobject and createobject methoid
with reference of micro soft excel object libery 8.0

then the thing of text file we have to refer scripting object.

so you have to take the file system object

dim fs as new filesystem

if you want to code then i can send to you after your response
das

[Gunslinger]

thank you for your reply ... i actually managed to get it sorted lastnight .... here is the 3 pieces of code i came up with ..... for those who may be trying something similar ....

from a user for with 2 buttons run this code ...

Private Sub CommandButton1_Click()
    InOut_Select.Hide
    getmydata
End Sub
 
Private Sub CommandButton2_Click()
    InOut_Select.Hide
        On Error Resume Next
        Dim Pt As String
        Pt = ThisWorkbook.Path & "\Personal Information Files"
        'Pt = 1909b workbook directory and new folder name
        MkDir (Pt)
    writemydata
End Sub

then to export .......

'
Option Explicit
Option Base 1
'
' Saves Users Basic Details
'
Sub writemydata()
'
On Error GoTo errhandler
'
Dim Mycells(39) As Range
Dim i As Integer
Dim icell As Range
Dim nme As String
    nme = Sheets("1909").Range("I16").Text & " " & Sheets("1909").Range("E16").Text
Dim Pth As String
    Pth = ThisWorkbook.Path & "\Personal Information Files\" & "Basic Details for " & nme & " as of " & Format$(Now, "DD-MM-YY hhnn.ss") & ".csv"
'
Open Pth For Output As #1
'
   ' 1909 Monthly details to save
'
Set Mycells(1) = Sheets("1909").Range("C4")
Set Mycells(2) = Sheets("1909").Range("C5")
Set Mycells(3) = Sheets("1909").Range("C6")
Set Mycells(4) = Sheets("1909").Range("K3")
Set Mycells(5) = Sheets("1909").Range("F6")
Set Mycells(6) = Sheets("1909").Range("K8")
Set Mycells(7) = Sheets("1909").Range("C11")
Set Mycells(8) = Sheets("1909").Range("B16")
Set Mycells(9) = Sheets("1909").Range("E16")
Set Mycells(10) = Sheets("1909").Range("I16")
Set Mycells(11) = Sheets("1909").Range("L16")
Set Mycells(12) = Sheets("1909").Range("O16")
Set Mycells(13) = Sheets("1909").Range("G18")
Set Mycells(14) = Sheets("1909").Range("K18")
Set Mycells(15) = Sheets("1909").Range("N17")
Set Mycells(16) = Sheets("1909").Range("C79")
'
    ' 1909 Certify details to save
'
Set Mycells(17) = Sheets("Certify").Range("C11")
Set Mycells(18) = Sheets("Certify").Range("C13")
Set Mycells(19) = Sheets("Certify").Range("C15")
Set Mycells(20) = Sheets("Certify").Range("G11")
Set Mycells(21) = Sheets("Certify").Range("G15")
'
    ' 1943 Detail to save
'
Set Mycells(22) = Sheets("1943").Range("F18")
'
    ' AL Details to save
'
Set Mycells(23) = Sheets("AL").Range("O8")
Set Mycells(24) = Sheets("AL").Range("M9")
Set Mycells(25) = Sheets("AL").Range("AJ8")
Set Mycells(26) = Sheets("AL").Range("AH9")
Set Mycells(27) = Sheets("AL").Range("I19")
Set Mycells(28) = Sheets("AL").Range("AG17")
Set Mycells(29) = Sheets("AL").Range("C22:I60")
Set Mycells(30) = Sheets("AL").Range("U20:AG60")
'
    ' 1937 Details to save
'
Set Mycells(31) = Sheets("1937").Range("K28")
Set Mycells(32) = Sheets("1937").Range("K29")
Set Mycells(33) = Sheets("1937").Range("K30")
Set Mycells(34) = Sheets("1937").Range("M31")
Set Mycells(35) = Sheets("1937").Range("AP27")
Set Mycells(36) = Sheets("1937").Range("Y34")
Set Mycells(37) = Sheets("1937").Range("AM34")
Set Mycells(38) = Sheets("1937").Range("BA34")
Set Mycells(39) = Sheets("1937").Range("TextOld")
'
For i = LBound(Mycells) To UBound(Mycells)
'
    For Each icell In Mycells(i)
        Write #1, icell.Value, icell.Worksheet.name, icell.Address
    Next
Next i
'
Close #1
'
MsgBox "Export complete, and appears to be ok", vbInformation, "Success !"
'
GoTo Resultok
'
errhandler:
    MsgBox "An error was encountered during the export process, the data saved may be corrupt or missing completely.", vbExclamation, "Warning !"
    Close #1
    Exit Sub
'
Resultok:
'
End Sub

then to import data back .....

'
Option Private Module
Option Base 1
'
Sub getmydata()
'
On Error GoTo oops
'
Dim mydata(3)
Dim myFile As Variant
Dim Checkarchive As String
'
    myFile = Application.GetOpenFilename("Text Files (*.csv), *.csv", , "Choose File to Import")
    If myFile <> False Then
'
Application.ScreenUpdating = False
'
Open myFile For Input As #1
'
Do While Not EOF(1)
'
Input #1, mydata(1), mydata(2), mydata(3)
'
Checkarchive = mydata(2)
'
If Checkarchive <> "1909" Then
    If Checkarchive <> "Certify" Then
        If Checkarchive <> "1943" Then
            If Checkarchive <> "AL" Then
                If Checkarchive <> "1937" Then
                    MsgBox "An error occured during the importing process, the selected file may not be intended for this workbook, or may be corrupted, the requested data may be incorrect or incomplete, check all entries carefully", vbExclamation, "Warning !"
    Close #1
    Exit Sub
'
                End If
            End If
        End If
    End If
End If
'
    Select Case mydata(1)
        Case "#NOTHING#"
        Sheets(mydata(2)).Range(mydata(3)).Value = ""
'
    Case Else
        Sheets(mydata(2)).Range(mydata(3)).Value = mydata(1)
    End Select
'
Loop
'
Close #1
'
Sheet16.Enquirytext.Text = Sheet16.Range("TextOld")
'
Application.ScreenUpdating = True
'
MsgBox "Import complete, and appears to be ok", vbInformation, "Success !"
'
GoTo Resultgood
 
oops:
    Application.ScreenUpdating = True
'
    MsgBox "An error occured during the importing process, the selected file may not be intended for this workbook, or may be corrupted, the requested data may be incorrect or incomplete, check all entries carefully", vbExclamation, "Warning !"
    Close #1
    Exit Sub
'
Resultgood:
'
Else
    Exit Sub
End If
'
End Sub

thats all folks ..... thanks for your help

gunslinger

[stono]

Can you please send working example of this process ? the code looks nice but with a working excel book it would be more clearer .
thanks

[Gunslinger]

Originally posted by stono
Can you please send working example of this process ? the code looks nice but with a working excel book it would be more clearer .
thanks

stono ... sure, just a couple of things tho ... the workbook alone
that code is in is over 1.5mb, and it is also locked down fairly tight,
so all you would see is the process running and not have access
to the code.
Plus some of that code would not be required in your project.

what i suggest is email me, addy should be available, put in title
"code request" ... then in the email explain a little about what you
need to use it for and i will trim it and place the code into a blank
workbook for you, so you can see how it works

ok ?

Gunslinger