• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 231
  • Last Modified:

copy text to multiple excel files

Hi - I need to copy a string (e.g. disclaimer) to the bottom of 100 Excel files that are located in the same directory.  The text verbiage (e.g. "my verbiage") would go to 3 lines below the last line of text, but if that is difficult I could settle of having the verbiage go to a specific cell in all files (A65).  Is there an easy way to do this using VBA other than manually open each Excel file and paste the verbiage?  Thanks,
0
eklin
Asked:
eklin
  • 4
  • 3
1 Solution
 
Ejgil HedegaardCommented:
Sure that is possible, to let VBA open the files, write the text, save the file, and close.
If sheets are protected, some extra action must be performed to handle that.

I have set it to write to A65, (the easy solution), on each sheet in the workbook.
If it is only to be written to one specific sheet that is also possible.

It is difficult to detect the last cell.
The property UsedRange often contains more rows than is actually used, due to changes in the worksheet, and charts below last row is not part of it.
ws.Range("A65") could be replaced with ws.Cells(ws.UsedRange.Rows.Count+3,1)

Copy a few files to a new folder, and test.
The program asks you to select one of the files in the folder, any will do.

Allow macros to run when opening the file.
To run the program use Alt+F11 to open the VBA editor, select Module1, and Run

Here is the code

Option Explicit

Sub InsertTextInFile()
    Dim vDirSelect As Variant, iPosition As Integer, iPositionEnd As Integer
    Dim sTextToInsert As String, sFilename As String
    Dim wb As Workbook, ws As Worksheet
    
    sTextToInsert = "WRITE DISCLAIMER TEXT HERE"
    
    vDirSelect = Application.GetOpenFilename(FileFilter:="Excel files (*.xls*),*.xls*", Title:="Select a file in the directory")
    If vDirSelect = False Then End
    
    Application.ScreenUpdating = False
    
    For iPosition = 1 To Len(vDirSelect)
        If Mid(vDirSelect, iPosition, 1) = "\" Then
            iPositionEnd = iPosition
        End If
    Next iPosition
    vDirSelect = Left(vDirSelect, iPositionEnd)
    
    sFilename = Dir(vDirSelect + "*.xls*", vbNormal)
    Do While Len(sFilename) > 0
        Do While FileLocked(vDirSelect + sFilename)
            MsgBox "File " + sFilename + " open"
        Loop
           
        Application.EnableEvents = False
        Application.DisplayAlerts = False
        Set wb = Application.Workbooks.Open(Filename:=vDirSelect + sFilename)
        For Each ws In wb.Worksheets
            ws.Range("A65") = sTextToInsert
        Next ws
        wb.Save
        wb.Close
        Application.DisplayAlerts = True
        Application.EnableEvents = True
            
        sFilename = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Function FileLocked(strFileName As String) As Boolean
   On Error Resume Next
   Open strFileName For Binary Access Read Write Lock Read Write As #1
   Close #1
   If Err.Number <> 0 Then
      FileLocked = True
      Err.Clear
   End If
End Function

Open in new window

Insert-text-in-files.xlsm
0
 
eklinAuthor Commented:
Thanks!  I tried the code above but get an error that says: "Run time error '1004'.  Application defined or object defined error".  Any ideas why?
0
 
Ejgil HedegaardCommented:
At what line is the error?
0
Technology Partners: 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!

 
eklinAuthor Commented:
I don't know.  After the error it returns to the first line of the sub.  If I go line by line F8 and shift F8, the error doesn't appear but it goes in a "infinite" loop. without completing.
0
 
eklinAuthor Commented:
It works at home fine, where I have Excel 2007 and ran using Excel 2003 files.  However, at work I have Excel 2010 and Excel 2003.  The files I tried to update were in Excel 2003 format but produced with Excel 2010.  They had conditional formatting in it and some hidden rows.  When the program ran without errors (using Excel 2003), the output files became unreadable with garbage on them.  I am guessing it must be some type of compatibility issue.
0
 
Ejgil HedegaardCommented:
To avoid the infinite loop I have inserted a routine that reads the file names first, and then use the list for files to have the text inserted.
There is a known problem with the VBA Dir command, it only use 3 characters as extension, but it reads the file names correctly, so if you have 2 files with the same name both as xls, and xlsx, perhaps saving one of them causes the infinite loop, reading the file again.

Tested in Excel 2003, and got an error for xlsx files, "write protected", but they are not, so perhaps the converter to xlsx in Excel 2003 and VBA does not work together.
Could be Microsoft forgot it, like the extension problem for Dir.
Tested in Excel 2007 with files saved as xls from Excel 2007, no problem.
I think it is best to run in Excel 2007 or later, I use Excel 2007.

Hidden rows should not be a problem.
VBA can write to any cell, also hidden cells, and cells on hidden worksheets.
Insert-text-in-files-A.xlsm
0
 
eklinAuthor Commented:
It fixed the problem!  Thank you!!!
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now