Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
844 views
in Technique[技术] by (71.8m points)

excel - When I run my Macro to copy paste and remane a file I get "Out of Memory" vba error, what I'm doing wrong?

I have an excel file with a form, when the form is filled correctly then an OK button can be pressed. The button function is to create a file name, copy paste a master file and a specific folder (the address is stored in a cell) and rename this file. After it, the file is opened, some cells are filled with values and is saved and closed.

Code here:

Private Sub S_START_BTN_Click()

Dim Box_No As Integer                           'Box Number of the Session
Dim D As String, M As String, YE As String      'Date Elements
Dim O_LINK As String                            'Directory of Master File
Dim Line As String                              'Production Line
Dim COSE As String                              'Shop Order Text
Dim P_Coord As String                           'Row at which is the right project
Dim P_QT As Integer                             'target quanityt for the box
Dim CODEX As String                             'Flag for session
Dim CODEXO As String                            'Flag for session Open
Dim S_Coord As String                           'Row at which is the active session is
Dim SN_Open As String                           'Box tag of the open session
Dim S_LINK As String                            'Directory of the new file
Dim nomefile As String, nomemaster As String


'Get Data from the File

Box_No = ThisWorkbook.Sheets("SESSIONS_LOG").Range("H2").Value + 1
O_LINK = ThisWorkbook.Sheets("SESSIONS_LOG").Range("G2").Value & "" & "VERIFICATOR_MASTER.xlsm"
Line = ThisWorkbook.Sheets("SESSIONS_LOG").Range("D3").Value

'Get Date Elements

D = Format$(Day(Date), "0#")
M = Format$(Month(Date), "0#")
YE = Year(Date)

'Get Shop Order

If S_SOYN_DT.Value = True Then
    COSE = "NO_SHOP_ORDER"
Else
    COSE = S_SO_DT
End If

'Get the target quantity

P_Coord = "K" & ThisWorkbook.Sheets("PROJECTS_DATABASE").Range("C:C").Find(What:=S_PS_DT, LookIn:=xlValues).Row
P_QT = ThisWorkbook.Sheets("PROJECTS_DATABASE").Range(P_Coord).Value

'Make the flag and check if other boxes like this exist

CODEX = YE & M & D & "-" & Line & "-" & S_PS_DT & "-" & COSE & "-" & P_QT & "-" & Left(S_PT_DT, 1)
CODEXO = CODEX & "-" & "O"

If Not IsError(Application.Match(CODEXO, ThisWorkbook.Sheets("SESSIONS_LOG").Range("J:J"), 0)) Then
  
     If MsgBox("Another session with same parameters is active, open it?", vbQuestion + vbYesNo, "Ready to Exit?") = vbNo Then
     
        'There is an open session, I don't want to open it
     
        ThisWorkbook.Sheets("SESSIONS_LOG").Range("A6:M6").Delete Shift:=xlUp
        Unload Me
        
     Else
        
        'There is an open session, I want to open it
        
        S_Coord = "F" & ThisWorkbook.Sheets("SESSIONS_LOG").Range("J:J").Find(What:=CODEXO, LookIn:=xlValues).Row
        SN_Open = ThisWorkbook.Sheets("SESSIONS_LOG").Range(S_Coord).Value
        S_LINK = ThisWorkbook.Sheets("SESSIONS_LOG").Range("G1").Value & "" & SN_Open & ".xlsm"
        Workbooks.Open (S_LINK)
        ThisWorkbook.Sheets("SESSIONS_LOG").Range("A6:M6").Delete Shift:=xlUp
        Unload Me
    
     End If

Else

'There is no other sessions with this tag, make a new

    ThisWorkbook.Sheets("SESSIONS_LOG").Range("J6").Value = CODEXO
    SN_Open = CODEX & "-" & Worksheets("SESSIONS_LOG").Range("A6").Value
    ThisWorkbook.Sheets("SESSIONS_LOG").Range("F6").Value = SN_Open
    S_LINK = Worksheets("SESSIONS_LOG").Range("G1").Value & "" & SN_Open & ".xlsm"
    
    'Make new file
    
    FileCopy O_LINK, S_LINK
    Workbooks.Open (S_LINK)
    
    nomefile = SN_Open & ".xlsm"
    nomemaster = ThisWorkbook.Name
    
    'Write variables
    
    With Workbooks(nomefile).Sheets("VERIFICATION_MASTER_FULL")
        .Range("A2").Formula = Workbooks(nomemaster).Sheets("SESSIONS_LOG").Range("F4").Value                   'Supplier address
        .Range("J2").Formula = Date
        .Range("E8").Formula = Workbooks(nomemaster).Sheets("SESSIONS_LOG").Range("A6").Value                   'Box Number
        .Range("C8").Formula = Workbooks(nomemaster).Sheets("SESSIONS_LOG").Range("D3").Value                   'Line
        .Range("C10").Formula = Workbooks(nomemaster).Sheets("SESSIONS_LOG").Range("C4").Value                  'operator ID
        .Range("F8").Formula = COSE                                                                             'SO
        .Range("B12").Formula = Workbooks(nomemaster).Sheets("SESSIONS_LOG").Range("C4").Value                  'operator ID
        .Range("C12").Formula = Workbooks(nomemaster).Sheets("SESSIONS_LOG").Range("C3").Value                  'operator level
    End With
    
    'Close, save and unload
    
    Workbooks(nomefile).Close SaveChanges:=True
    Worksheets("SESSIONS_LOG").Range("H2").Value = Worksheets("SESSIONS_LOG").Range("H2").Value + 1
    Unload Me
   
End If

End Sub

Unfortunately after a random times, from 1 to 40, excel gives me an error "Out of Memory". After which I lose the links in my files (which are transferred to the roaming file) and the program crashes. The file has no values, only few cells filled with numbers, no formulas and no conditional formatting of any kind. Same for the copied file, also no values, not formulas and no formatting.

What You think is causing the memory issue?

I've tried all possible Microsoft walk around but many of them are not applicable because I simply do not have formulas. PC is recent, 16GB ram, office is updated.

Thanks


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

I think the problem is that you handle empty content that takes up memory.

Try to substitute in the code everything related to whole columns (which affect all the rows of the file, whether they are full or empty)

Range("C:C")

For a more specific range that takes up less memory

Range("C1:C10000")

Bye


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...