vb6 code to copy cell value from one workbook to another and it should be d

[Siddharth_1]

I want to make a interface in vb6 which deals with excel file. Where we can select drive from drive box and select a excel file which is a source file and copy the value of cell from the source file and paste it into destination file's cell. my problem is i want it dynamic mean i will take excel file, sheet and cell from user in runtime.

(this is the source excel file from where i want to copy the value of the cell)I m selecting excel file from filelistbox and then selecting a sheet from combobox where the sheets will b listed and then giving cell number from textbox and with d help of the command i show data that cell contains in a text box.

(this the destination file where i want to paste the cell value that i copied) again in same way i giving the destination file and sheet n cell . i want the code for a command button which will paste the value of copied cell to the destination cell. i tried many thing but nothing works.

i made 2-3 function for copy cell but it doesnt work And i m using VB6

this is my code

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowcmd As Long) As Long

Private Const SW_SHOWNORMAL = 1






Private Sub Check1_Click()
MsgBox ("ok")
End Sub

Private Sub Form_Load()
Text3.Text = Text
Text4.Text = Text
Text7.Text = Text
Text8.Text = Text
End Sub


Private Sub Combo1_Click()
Text3.Text = Combo1.Text
End Sub



Private Sub Combo2_Click()
Text4.Text = Combo2.Text
End Sub



Private Sub gnt_db_cmd_5_Click()
Dim dbApp As Excel.Application
Dim dbBook As Excel.Workbook
Set dbApp = New Excel.Application
Set dbBook = dbApp.Workbooks.open(Text7.Text)
dbApp.Visible = True
Set dbBook = Nothing
Set dbApp = Nothing
End Sub

Private Sub exit_Click()
End
End Sub

Private Sub clearall_Click()
Text1.Text = " "
Text2.Text = " "
Text3.Text = " "
Text4.Text = " "
Text5.Text = " "
Text6.Text = " "
Text7.Text = " "
Text8.Text = " "
Text9.Text = " "
Combo1.Clear
Combo2.Clear
End Sub

Private Sub Dir1_Change()
File1.Pattern = "*.xlsb;*.xls;*.xlsx;*.xlsm;*.xltx;*.xlt;*xml;*.xlam;*xla;*.xlw;*.xll;*.xltm;*.xlm"
File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
If Option1.Value = True Then
Dir1.Path = Left$(Drive1.Drive, 1) & ":\"
    Else:
        If Option2.Value = True Then Dir1.Path = Left$(Drive1.Drive, 1) & ":\"

End If

End Sub

Private Sub File1_Click()
If Option1.Value = True Then
    Text1 = File1.List(File1.ListIndex)
    Text7 = File1.Path & "\" & File1
    Combo1.Clear
    Else:
        If Option2.Value = True Then
        Text2 = File1.List(File1.ListIndex)
        Text8 = File1.Path & "\" & File1
        Combo2.Clear
        End If
End If

End Sub

Private Sub File1_DblClick()
FileName = File1.Path
If Right$(FileName, 1) <> "\" Then FileName = FileName & "\"
FileName = FileName & File1.FileName
ShellExecute Me.hwnd, vbNullString, File1.FileName, vbNullString, Dir1.Path, SW_SHOWNORMAL
End Sub

Private Sub Combo1_GotFocus()
If Text7.Text = "" Then
Text7.Text = ""

Else

'Dim MyXLApp As Excel.Application
'Dim MyXLWorkBook As Excel.Workbook

'Set MyXLApp = New Excel.Application

'Set MyXLWorkBook = MyXLApp.Workbooks.Open(Text7.Text)

'For i = 1 To MyXLWorkBook.Sheets.Count
'Set myXLSheet = MyXLWorkBook.Sheets(i)


'With my_XLSheet
'.Unprotect
'.Select
'End With '


'Combo1.AddItem myXLSheet.Name

'Next i

'End If

Dim oxl As Object
Set oxl = CreateObject("Excel.Application")

Set oxlwbk = oxl.Workbooks.open(Text7.Text)
 For i = 1 To oxlwbk.Sheets.Count
 Set oxlsht = oxlwbk.Sheets(i)

 With oxlsht
 .Unprotect
  End With

 Combo1.AddItem oxlsht.Name
 Next i
 End If

End Sub


Private Sub Combo2_GotFocus()
If Text8.Text = "" Then
Text8.Text = ""

Else

Dim My_XLApp As Excel.Application
Dim My_XLWorkBook As Excel.Workbook

Set My_XLApp = New Excel.Application

Set My_XLWorkBook = My_XLApp.Workbooks.open(Text8.Text)

For i = 1 To My_XLWorkBook.Sheets.Count

Set my_XLSheet = My_XLWorkBook.Sheets(i)

With my_XLSheet
.Unprotect
'.Select
End With

Combo2.AddItem my_XLSheet.Name

Next i

End If

End Sub


Private Sub Command1_Click()
Dim objExcel As New Excel.Application     ' Source Excel
Dim objWorkbook As Excel.Workbook     'source workbook object
Dim objWorksheet As Excel.worksheet     'source worksheet object



Set objWorkbook = objExcel.Workbooks.open(Text8.Text)
Set objWorksheet = objWorkbook.Sheets(Text4.Text)
Text9.Text = objWorksheet.Range(Text6.Text).Value
End Sub

Private Sub Command4_Click()
If Text7.Text = "" Then
    MsgBox ("Enter the Cell Number")
Else
    'copy
    'CopyOpenItems
    copy_c

End If
End Sub

Sub copy()
Dim xl As New Excel.Application
Dim wbksour As Workbook
Dim wbkdes As Workbook
Dim strFirstFile As String
Dim strSecondFile As String

strFirstFile = Text8.Text
strSecondFile = Text7.Text

Set wbksour = xl.Workbooks.open(strFirstFile)

With wbksour.Sheets(Text4.Text)
.Range(Text6.Text).copy
End With

Set wbkdes = xl.Workbooks.open(strSecondFile, , False)

With wbkdes
.Activate
.ReadOnlyRecommended = False
End With

With wbkdes.Sheets(Text3.Text)
.Range(Text5.Text).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With


With wbkdes
.Activate
.Save
.Close False, Text7.Text
End With
xl.quit

 Set wbkdes = Nothing
 Set xl = Nothing


End Sub

Sub copy_c()
Dim wbksour As Object
Dim Source As Object
Dim wbkdes As Object
Dim des As Object
Dim strFirstFile As String
Dim strSecondFile As String

strFirstFile = Text8.Text
strSecondFile = Text7.Text

Application.ScreenUpdating = False

Set Source = CreateObject("Excel.Application")
Set wbksour = Source.Workbooks.open(strFirstFile)

With wbksour.Sheets(Text4.Text)
.Range(Text6.Text).copy
End With

'wbksour.Sheets(Text4.Text).Range(Text6.Text).copy

Set des = CreateObject("Excel.Application")
Set wbkdes = des.Workbooks.open(strSecondFile, , False)

With wbkdes
.Activate
.ReadOnlyRecommended = False
End With

With wbkdes.Sheets(Text3.Text)
    .Range(Text5.Text).PasteSpecial Paste:=xlPasteValues
End With

'wbkdes.Sheets(Text3.Text).Range(Text5.Text).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    'False, Transpose:=False



With wbkdes
.Activate
.Save
.Close
End With

Application.ScreenUpdating = True

End Sub

Sub CopyOpenItems()
    Dim xl As New Excel.Application

   Dim wbTarget            As Workbook 'workbook where the data is to be pasted
   Dim wbThis              As Workbook 'workbook from where the data is to copied
   Dim strName             As String   'name of the source sheet/ target workbook

   'set to the current active workbook (the source book)
   Set wbThis = xl.Workbooks.open(Text8.Text)

   'get the active sheetname of the book
   strName = ActiveSheet.Name

   'open a workbook that has same name as the sheet name
   Set wbTarget = xl.Workbooks.open(Text7.Text, , False)

   'select cell A1 on the target book   wbTarget.Range("A1").Select

   'clear existing values form target book
   wbTarget.Sheets(Text3.Text).Range(Text5.Text).Clear


   'activate the source book
   wbThis.Activate

   'clear any thing on clipboard to maximize available memory
   Application.CutCopyMode = False

   'copy the range from source book
   wbThis.Sheets(Text4.Text).Range(Text6.Text).copy

   'paste the data on the target book
   wbTarget.Sheets(Text3.Text).Range(Text5.Text).PasteSpecial

   'clear any thing on clipboard to maximize available memory
   Application.CutCopyMode = False

   'save the target book
   wbTarget.Save

   'close the workbook
   wbTarget.Close

   'activate the source book again
   wbThis.Activate

   'clear memory
   Set wbTarget = Nothing
   Set wbThis = Nothing

End Sub

[Klahr_R]

If I am reading your request correctly you have 4 tasks
1. Populate your vb6 form with choices for available Drives, directorys, workbooks and worksheets
2. User selects drive, directory, workbook and range to be copied and these are assigned to appropriate objects in VB6.
3. A workbook used for a target is open and the sheet and range to receive the info are assigned to appropriate objects.
4. Copy from source to target

It is not clear (to me) which of these tasks you have accomplished.
It would also be helpful to know what operating system you are using and which version of Excel you are using, or if those versions must deal with multiple platforms.

My first choice for selecting the source file would be to use the Windows.Application.GetOpenFileName to select your source file (which would allow selecting drive, directory etc.). However, the filter process for the type of file seems to vary between operating systems.

It isn't clear what information is in your text box used to open a workbook. If it is not a complete path then it will fail.

If you have resolved assigning your source and target sheets and determining what cell to copy as a ranged (ie "A1:C5"), then copying is simply:
Dim UserSelectedRange as string
TargetSheet.Range("A1").value = SourceSheet.Range(UserSelectedRange).value
When copying this way it is best if the two ranges match dimensions (single cell or block of the equal number of rows and columns)
A little more information would be helpful.
Regards

[Siddharth_2]

i hv done everything but i m facing problem when i saving the updated destination file wen i try to save it if make a copr of original which i dont want i want to over wtite it bt wen i try that its give runtime error or read-only memory i tried many thing change the property of file bt still no change i m stuck when i save the file

[Siddharth_2]

ANd i dont want to fice any range bcoz everything i m asking from user

[Klahr_R]

'In VBA any workbook to save only
If Me.Saved = False the Me.Save

OR

' If closing the workbooks VBA or VB6
sourceBook.Close True ' True saves changes; False doesn't save
TargetBook.Close True

then set objects to nothing

' For VB6
Application.Quit

If you are trying to save the sheet then it will make a copy
hope that helps.

[Siddharth_1]

i did that but it is still making a copy when i owerwrite it it say cannot access read-only file

[Siddharth_1]

i did that but it is still making a copy when i owerwrite it it say cannot access read-only file

[Klahr_R]

First guess is the target file has been opened as read only. If saving the file with a unique, new name is not a possibility then you will need to find out why it is opening as read only. There are several possibilities.

Since you are developing your application, you might have created an instance of the file which did not get closed. The next time run your vb6 and open the Excel file it will open a read only copy. I only do desk top applications so I can reboot to clear memory, then try running the exe again.

If you are on a network and someone else has the file open, then you get a read-only copy of the file.

Or the file is marked as read only to start with. Find the target file in Windows Explorer (My Computer). Right click the file and click "Properties". On the General Tab (Attributes at the bottom) uncheck the Read Only check box. (It would be good to know why it was marked read only to start with.)

Are the source file and the target file the same version of Excel?

If none of that works, check back

[Siddharth_1]

Sub copy()
Dim xl As New excel.Application
Dim wbksour As Workbook
Dim wbkdes As Workbook
Dim strFirstFile As String
Dim strSecondFile As String

strFirstFile = Text8.Text
strSecondFile = Text7.Text

Set wbksour = xl.Workbooks.Open(strFirstFile)

With wbksour.Sheets(Text4.Text)
.Range(Text6.Text).copy
End With

Set wbkdes = xl.Workbooks.Open(strSecondFile, , False)

With wbkdes
.Activate
.ReadOnlyRecommended = False
End With

With wbkdes.Sheets(Text3.Text)
.Range(Text5.Text).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With

wbksour.Close False
wbkdes.Close True

xl.Quit

End Sub

yup both are of same version. i tried to change the property but still same result i m giving u the program where copy is being done check where i need updation. text is the souerce path with file name and text7 is destination path with file name.
text3 is the destination sheet
text5 is destination cell where i m pasting the cell value which i copied
text4 is source sheet
text6 is source cell from where i m copying the value of cell

[Klahr_R]

I copied your code into a project, created the 8 text boxes and gave them values per your last post.
I created two folders named MyTarget and MySource. I saved a workbook to each folder with similar names.
I indluded a command button to run the sub (which I renamed to CopyMyData.
It all worked as expected and the value of A1 In the Source was copied to A1 in the target book.

So, having vaidated the code, I tried setting the ReadOnly value in the properties of the Target book
It all failed. I then unchecked the Read Only box in properties and the sub worked with out any problem.

I then opened the target book and ran the sub again. The program locked up with no error message. I had to close Excel in Task Manager/Processes before I could stop the vb6 code.

If you find the target workbook (not opened) in its file folder and right click the file and the attritubets box for Read Only is checked, to the best of my knowledge, this value cannot be changed programatically.

I found this article at Microsoft Support.
If you don't find your answer from this article I would suggest you start a new thread about dealing with a Read Only Excel file.
Best of Luck, your almost there.

[Siddharth_1]

thnx for the help and giving time for this problem

[Klahr_R]

Well, I don't like getting beat, so I did some more digging.
Here are some of the things that I found:
The FOLDER containing the file is marked read only?
or
Where you have the .Activate add

.ChangeFileAccess xlReadWrite

Look at the wb.open(fileName, one of these arguments out here is ignore open read only: set that to true
or
Open your target work book; Click SaveAs\click Tools\Click General Options: in the Save Options window, near the bottom, uncheck the Read-Only Recommended box, then save the workbook

When I have the read only box checked on the properties sheet none of this works. The program always crashes with a remote proceedure error, so that probably isn't it.
If the file isn't open any place else one of the above should work.
Let me know, for future reference.

[Siddharth_1]

Thanx i will try this . And dere is on more thing i got the solution what i was asking. Just remove that line "Dim xl As New excel.Application" and dont use "with vb.....end with" and it will save without any problem. BUt i am facing problem when i try to open the excel file from windows not from the program after i use my program then it says can only open in read-only and then the excel file keep running in loop i never able to close that excel file then i have to use task mannager to close those several excel file. And thank you for your help .