Solved

Problem writing data to Excel

Posted on 2004-08-30
14
191 Views
Last Modified: 2010-05-02
Hi - I've created the following app that does the following:
     (1) creates a new Excel workbook
     (2) Select folders path
     (3) generates a list of sub-folders based on parent folders
     (4) writes list of sub-folders to Excel workbook.  

It works fine if you only have a few sub-folders; however, when you get more than 10 it asks "Do you want to save the changes you maed to 'Text.xls'?"

'----------------------------------------------------------------------------------
Sub ListFolders(strPath As String)
On Error Resume Next

    cmdGenerateList.Visible = False
   
    Dim fso, fld, f As Object
    Dim NewF
    Set NewF = f
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(strPath)
   
    Dim xl As New Excel.Application
    Dim wb As Excel.Workbook
    Dim ws As Excel.Worksheet
    Dim strRange As String
    Dim strRow As String
   
    Set wb = xl.Workbooks.Open(strSavePath)
    Set ws = wb.Worksheets("Sheet1")
   
    strRow = 1
    strRange = "A" & strRow
   
    For Each f In fld.SubFolders
            ListFolders f.Path
            FolderDrive = f.Path
            ws.Range(strRange).Value = f.Path
            strRow = strRow + 1
            strRange = "A" & strRow
        Debug.Print f.Path
        wb.Application.Workbooks(1).Save
    Next
   
    'cleanup
    wb.Close
    xl.Quit
   
    Set wb = Nothing
    Set xl = Nothing
   
    cmdMoveFiles.Visible = False
    cmdDone.Visible = True
   
End Sub
'----------------------------------------------------------------------------------
0
Comment
Question by:eciabattari
  • 7
  • 7
14 Comments
 
LVL 22

Expert Comment

by:DarkoLord
ID: 11930954
I think the problem is that you are creating new excel instance for every subfolder... you should create excel instance only once and then recurse through all subfolders in a separate function... also, is it necessary to save the workbook after each folder?

Darko
0
 

Author Comment

by:eciabattari
ID: 11931269
OK, so if I understand you correctly, in one Sub I should create an instance of excel and in another sub execute my subfolder part?  Is this correct?
0
 
LVL 22

Expert Comment

by:DarkoLord
ID: 11931589
Yes

Darko
0
 

Author Comment

by:eciabattari
ID: 11931842
do have any samples?
0
 

Author Comment

by:eciabattari
ID: 11931852
I've created the following but I'm getting errors.

Public Function OpenExcel()
    Dim xl As New Excel.Application
    Dim wb As Excel.Workbook
    Dim ws As Excel.Worksheet

    Set wb = xl.Workbooks.Open(strSavePath)
    Set ws = wb.Worksheets("Sheet1")
   
End Function

Public Sub WriteExcel()

    Debug.Print strRange
    Debug.Print strFolderPath2
   
    ws.Range(strRange).Value = strFolderPath2
    wb.Application.Workbooks(1).Save
   
End Sub

Private Sub CloseExcel()
    wb.Application.Workbooks(1).Save
 
    'cleanup
    wb.Close
    xl.Quit
   
    Set wb = Nothing
    Set xl = Nothing
   
End Sub
0
 
LVL 22

Accepted Solution

by:
DarkoLord earned 500 total points
ID: 11931959
Move these to the top of the module

    Dim xl As New Excel.Application
    Dim wb As Excel.Workbook
    Dim ws As Excel.Worksheet
    Dim fso As Object, fld As Object, f As Object
    Dim NewF As Object

darko
0
 

Author Comment

by:eciabattari
ID: 11932127
I'm getting the error "object required" within:

Private Sub CloseExcel()
    wb.Application.Workbooks(1).Save
End Sub
0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 
LVL 22

Expert Comment

by:DarkoLord
ID: 11932232
It should work... post your entire code...

Darko
0
 

Author Comment

by:eciabattari
ID: 11932267
Here is it.... BTW, thanks for the help.

'--------------------------------------------------------------------------------------------------------------------------------------------
Dim lFileName As String
Dim strFileNameCheck
Dim FolderDrive As String
Dim strFolderPath As String

Private Type BrowseInfo
    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type
Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long


Dim strSavePath As String
Dim strFolderPath2 As String
Dim strRange As String
Dim strRow As String


Private Sub About_Click()
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    frmAbout.Show
End Sub

Private Sub cmdDone_Click()
    Unload Me
End Sub

Public Sub cmdSaveAs_Click()
    CommonDialog1.ShowSave
   
    strSavePath = CommonDialog1.FileName
   
    Dim sName As String
    Dim wbk As Workbook
    Dim owbk As Workbook
   
    Set owbk = ActiveWorkbook
 
    sName = strSavePath
    Set wbk = Workbooks.Add
    wbk.SaveAs sName
   
    wbk.Close msoTrue
   
    cmdSaveAs.Visible = False
    cmdSelectPath.Visible = True
   
End Sub

Private Sub cmdSelectPath_Click()
       
    Call GetFolderInfo
    txtPath.Text = strFolderPath & "\"
   
    cmdGenerateList.Visible = True
    cmdSelectPath.Visible = False
   
End Sub
Private Sub GetFolderInfo()

    Dim iNull As Integer, lpIDList As Long, lResult As Long
    Dim sPath As String, udtBI As BrowseInfo

    With udtBI
       'Set the owner window
        .hWndOwner = Me.hWnd
        'lstrcat appends the two strings and returns the memory address
        .lpszTitle = lstrcat("C:\", "")
        'Return only if the user selected a directory
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With

    'Show the 'Browse for folder' dialog
    lpIDList = SHBrowseForFolder(udtBI)
    If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        'Get the path from the IDList
        SHGetPathFromIDList lpIDList, sPath
        'free the block of memory
        CoTaskMemFree lpIDList
        iNull = InStr(sPath, vbNullChar)
        If iNull Then
            sPath = Left$(sPath, iNull - 1)
        End If
    End If
    strFolderPath = sPath
   
End Sub

Private Sub Form_Load()
On Error GoTo ErrorHandler

Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    frmMain.Height = 3355
    frmMain.Width = 9270
   
    cmdSaveAs.Visible = True
    cmdDone.Visible = False
    cmdGenerateList.Visible = False
    cmdSelectPath.Visible = False
   
   strRow = 1
   strRange = "A" & strRow

Exit Sub

ErrorHandler:

End Sub

Private Sub cmdGenerateList_Click()
   
    Call OpenExcel
    Call ListFolders(strFolderPath)
    Call CloseExcel

End Sub

Public Function OpenExcel()
    Dim xl As New Excel.Application
    Dim wb As Excel.Workbook
    Dim ws As Excel.Worksheet

    Set wb = xl.Workbooks.Open(strSavePath)
    Set ws = wb.Worksheets("Sheet1")
   
    Dim fso As Object, fld As Object, f As Object
    Dim NewF As Object
   
End Function

Public Sub WriteExcel()

    Debug.Print strRange
    Debug.Print strFolderPath2
   
    ws.Range(strRange).Value = strFolderPath2

End Sub

Private Sub CloseExcel()

    wb.Application.Workbooks(1).Save
   
    'cleanup
    wb.Close
    xl.Quit
   
    Set wb = Nothing
    Set xl = Nothing
   
End Sub

Sub ListFolders(strPath As String)
On Error Resume Next
   
    cmdGenerateList.Visible = False
   
'    Dim fso, fld, f As Object
'    Dim NewF
   
    Set NewF = f
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(strPath)
     
    For Each f In fld.SubFolders
        ListFolders f.Path
        FolderDrive = f.Path
        strFolderPath2 = f.Path
   
        Call WriteExcel
   
        strRow = strRow + 1
        strRange = "A" & strRow
       
    Next
   
    cmdMoveFiles.Visible = False
    cmdDone.Visible = True
   
End Sub

Private Sub Command1_Click()
    Screen.MousePointer = vbHourglass
    Command1.Enabled = False

    Command1.Enabled = True
    Screen.MousePointer = vbDefault
End Sub

'--------------------------------------------------------------------------------------------------------------------------------------------
0
 
LVL 22

Expert Comment

by:DarkoLord
ID: 11932319
Well you didn't move the variable declarations to the top as I said I my post above :)

Darko
0
 

Author Comment

by:eciabattari
ID: 11932371
works now.... thanks for all the help.
0
 
LVL 22

Expert Comment

by:DarkoLord
ID: 11932399
You're welcome

Darko
0
 
LVL 22

Expert Comment

by:DarkoLord
ID: 11933044
Please accept my answer if it's working as it should

Darko
0
 

Author Comment

by:eciabattari
ID: 11933427
Sorry about that.  Have a good one.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
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…
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…

708 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

18 Experts available now in Live!

Get 1:1 Help Now